diff options
| -rw-r--r-- | sucl/absmodule.dcl | 12 | ||||
| -rw-r--r-- | sucl/absmodule.icl | 47 | ||||
| -rw-r--r-- | sucl/cli.icl | 38 |
3 files changed, 40 insertions, 57 deletions
diff --git a/sucl/absmodule.dcl b/sucl/absmodule.dcl index 30fc4dd..fd2060a 100644 --- a/sucl/absmodule.dcl +++ b/sucl/absmodule.dcl @@ -5,11 +5,9 @@ definition module absmodule from rule import Rule :: Module sym pvar tsym tvar - = { //exportedtypesymbols :: [tsym] // Exported type symbols (from DCL) - //, typealias :: [(tsym,Rule tsym tvar)] // Alias types - typeconstructors :: [(tsym,[sym])] // All constructor symbols of each declared algebraic type - , exportedsymbols :: [sym] // Exported function/constructor symbols - //, aliases :: [(sym,Rule sym pvar)] // Macros - , typerules :: [(sym,(Rule tsym tvar,[Bool]))] // Info from type rules (actual type and argument strictnesses) - , rules :: [(sym,[Rule sym pvar])] // Rewrite rules of each symbol, absent if imported + = { typeconstructors :: [(tsym,[sym])] // All constructor symbols of each declared algebraic type + , exportedsymbols :: [sym] // Exported function/constructor symbols + , typerules :: [(sym,Rule tsym tvar)] // Principal types of symbols + , stricts :: [(sym,[Bool])] // Strict arguments of functions + , rules :: [(sym,[Rule sym pvar])] // Rewrite rules of each symbol, absent if imported } diff --git a/sucl/absmodule.icl b/sucl/absmodule.icl index fad7cf6..9b9d472 100644 --- a/sucl/absmodule.icl +++ b/sucl/absmodule.icl @@ -27,49 +27,12 @@ Includes. ------------------------------------------------------------------------ Module implementation. -> module * *** **** ***** -> == ( ( [****], || Exported types -> [(****,rule **** *****)], || Type alias rules -> [(****,[*])] || Constructor symbols for algebraic type symbol -> ), -> ( [*], || Exported symbols -> [(*,rule * ***)], || Alias rules -> [(*,(rule **** *****,[bool]))], || Typerule for symbol -> [(*,[rule * ***])] || Rewrite rules for symbol, absent if imported -> ) -> ) - */ :: Module sym pvar tsym tvar - = {// exportedtypesymbols :: [tsym] // Exported type symbols (from DCL) - //, typealias :: [(tsym,Rule tsym tvar)] // Alias types - typeconstructors :: [(tsym,[sym])] // All constructor symbols of each declared algebraic type - , exportedsymbols :: [sym] // Exported function/constructor symbols - //, aliases :: [(sym,Rule sym pvar)] // Macros - , typerules :: [(sym,(Rule tsym tvar,[Bool]))] // Info from type rules (actual type and argument strictnesses) - , rules :: [(sym,[Rule sym pvar])] // Rewrite rules of each symbol, absent if imported + = { typeconstructors :: [(tsym,[sym])] // All constructor symbols of each declared algebraic type + , exportedsymbols :: [sym] // Exported function/constructor symbols + , typerules :: [(sym,Rule tsym tvar)] // Principal types of symbols + , stricts :: [(sym,[Bool])] // Strict arguments of functions + , rules :: [(sym,[Rule sym pvar])] // Rewrite rules of each symbol, absent if imported } - -/* - -> newmodule :: module * *** **** ***** -> newmodule = (([],[],[]),([],[],[],[])) - -> addtalias :: **** -> bool -> rule **** ***** -> module * *** **** ***** -> module * *** **** ***** -> addtalias ts exp tr ((tes,tas,tcs),defs) -> = ((cond exp (ts:tes) tes,(ts,tr):tas,tcs),defs) - -> addtsymdef :: **** -> bool -> [*] -> module * *** **** ***** -> module * *** **** ***** -> addtsymdef ts exp ss ((tes,tas,tcs),defs) -> = ((cond exp (ts:tes) tes,tas,(ts,ss):tcs),defs) - -> addalias :: * -> bool -> rule * *** -> module * *** **** ***** -> module * *** **** ***** -> addalias s exp r (tdefs,(es,as,ts,rs)) -> = (tdefs,(cond exp (s:es) es,(s,r):as,ts,rs)) - -> addsymdef :: * -> bool -> rule **** ***** -> bool -> [rule * ***] -> module * *** **** ***** -> module * *** **** ***** -> addsymdef s exp t imp rr (tdefs,(es,as,ts,rs)) -> = (tdefs,(cond exp (s:es) es,as,(s,(t,[])):ts,cond imp rs ((s,rr):rs))) - -*/ diff --git a/sucl/cli.icl b/sucl/cli.icl index 2c808d0..8949eff 100644 --- a/sucl/cli.icl +++ b/sucl/cli.icl @@ -124,12 +124,12 @@ exports :: Cli -> [SuclSymbol] exports m = m.exportedsymbols /* -> typerule (tdefs,(es,as,ts,rs)) = fst.maxtypeinfo ts +> typerule (tdefs,(es,as,ts,rs)) = maxtyperule ts */ typerule :: Cli SuclSymbol -> Rule SuclTypeSymbol SuclTypeVariable typerule m sym -= fst (maxtypeinfo m.typerules sym) += maxtyperule m.typerules sym /* > rules (tdefs,(es,as,ts,rs)) = foldmap Present Absent rs @@ -154,7 +154,7 @@ typerule m sym clistrategy :: Cli ((Graph SuclSymbol SuclVariable) SuclVariable var -> Bool) -> Strategy SuclSymbol var SuclVariable answer | == var clistrategy {typeconstructors=tcs,typerules=ts,rules=rs} matchable - = ( checkarity (typearity o maxtypeinfo ts) // Checks curried occurrences and strict arguments + = ( checkarity (typearity o maxtyperule ts) // Checks curried occurrences and strict arguments o checklaws cleanlaws // Checks for special (hard coded) rules (+x0=x /y1=y ...) o checkrules matchable (foldmap id [] rs) // Checks normal rewrite rules o checkimport islocal // Checks for delta symbols @@ -163,11 +163,17 @@ clistrategy {typeconstructors=tcs,typerules=ts,rules=rs} matchable where islocal rsym=:(SuclUser s) = isMember rsym (map fst rs) islocal rsym = True // Symbols in the language core are always completely known -typearity :: (Rule SuclTypeSymbol SuclTypeVariable,[Bool]) -> Int -typearity ti = length (arguments (fst ti)) +typearity :: (Rule SuclTypeSymbol SuclTypeVariable) -> Int +typearity ti = length (arguments ti) -maxtypeinfo :: [(SuclSymbol,(Rule SuclTypeSymbol SuclTypeVariable,[Bool]))] SuclSymbol -> (Rule SuclTypeSymbol SuclTypeVariable,[Bool]) -maxtypeinfo defs sym = extendfn defs coretypeinfo sym +//maxtypeinfo :: [(SuclSymbol,(Rule SuclTypeSymbol SuclTypeVariable,[Bool]))] SuclSymbol -> (Rule SuclTypeSymbol SuclTypeVariable,[Bool]) +//maxtypeinfo defs sym = extendfn defs coretypeinfo sym + +maxtyperule :: [(SuclSymbol,Rule SuclTypeSymbol SuclTypeVariable)] SuclSymbol -> Rule SuclTypeSymbol SuclTypeVariable +maxtyperule defs sym = extendfn defs coretyperule sym + +maxstricts :: [(SuclSymbol,[Bool])] SuclSymbol -> [Bool] +maxstricts defs sym = extendfn defs corestricts sym /* > constrs ((tes,tas,tcs),defs) = tcs @@ -176,7 +182,7 @@ maxtypeinfo defs sym = extendfn defs coretypeinfo sym */ complete :: Cli -> [SuclSymbol] -> Bool -complete m = mkclicomplete m.typeconstructors (fst o maxtypeinfo m.typerules) +complete m = mkclicomplete m.typeconstructors (maxtyperule m.typerules) /* > showcli = printcli @@ -310,3 +316,19 @@ Compiling clean parts into module information... > ctgraph = updategraph ctroot (fn,[last targs,troot]) tgraph */ + +mkcli :: + [(SuclSymbol,Rule SuclTypeSymbol SuclTypeVariable)] + [(SuclSymbol,[Bool])] + [SuclSymbol] + [(SuclTypeSymbol,[SuclSymbol])] + [(SuclSymbol,[Rule SuclSymbol SuclVariable])] + -> Cli + +mkcli typerules stricts exports constrs bodies += { typeconstructors = constrs + , exportedsymbols = exports + , typerules = typerules + , stricts = stricts + , rules = bodies + } |