diff options
| author | zweije | 2001-08-29 14:28:04 +0000 |
|---|---|---|
| committer | zweije | 2001-08-29 14:28:04 +0000 |
| commit | b6872c96fe00ba33f5f965e87e94ebb6947d5dc0 (patch) | |
| tree | 419839479e5f119a241189d9a31847131dfc91ac | |
| parent | This commit was generated by cvs2svn to compensate for changes in r688, (diff) | |
This commit was generated by cvs2svn to compensate for changes in r690,
which included commits to RCS files with non-trunk default branches.
git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@691 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d
| -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 } |