diff options
| -rw-r--r-- | sucl/absmodule.dcl | 3 | ||||
| -rw-r--r-- | sucl/absmodule.icl | 3 | ||||
| -rw-r--r-- | sucl/cli.icl | 11 |
3 files changed, 10 insertions, 7 deletions
diff --git a/sucl/absmodule.dcl b/sucl/absmodule.dcl index fd2060a..fa81565 100644 --- a/sucl/absmodule.dcl +++ b/sucl/absmodule.dcl @@ -5,7 +5,8 @@ definition module absmodule from rule import Rule :: Module sym pvar tsym tvar - = { typeconstructors :: [(tsym,[sym])] // All constructor symbols of each declared algebraic type + = { arities :: [(sym,Int)] // Arity of each symbol + , 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 diff --git a/sucl/absmodule.icl b/sucl/absmodule.icl index 9b9d472..4c0f1be 100644 --- a/sucl/absmodule.icl +++ b/sucl/absmodule.icl @@ -30,7 +30,8 @@ Module implementation. */ :: Module sym pvar tsym tvar - = { typeconstructors :: [(tsym,[sym])] // All constructor symbols of each declared algebraic type + = { arities :: [(sym,Int)] // Arity of each symbol + , 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 diff --git a/sucl/cli.icl b/sucl/cli.icl index 8949eff..a992b00 100644 --- a/sucl/cli.icl +++ b/sucl/cli.icl @@ -153,8 +153,8 @@ 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 maxtyperule ts) // Checks curried occurrences and strict arguments +clistrategy {arities=as,typeconstructors=tcs,typerules=ts,rules=rs} matchable + = ( checkarity (extendfn as (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 @@ -322,13 +322,14 @@ mkcli :: [(SuclSymbol,[Bool])] [SuclSymbol] [(SuclTypeSymbol,[SuclSymbol])] - [(SuclSymbol,[Rule SuclSymbol SuclVariable])] + [(SuclSymbol,(Int,[Rule SuclSymbol SuclVariable]))] -> Cli mkcli typerules stricts exports constrs bodies -= { typeconstructors = constrs += { arities = map (mapsnd fst) bodies + , typeconstructors = constrs , exportedsymbols = exports , typerules = typerules , stricts = stricts - , rules = bodies + , rules = map (mapsnd snd) bodies } |