From b6872c96fe00ba33f5f965e87e94ebb6947d5dc0 Mon Sep 17 00:00:00 2001
From: zweije
Date: Wed, 29 Aug 2001 14:28:04 +0000
Subject: 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
---
 sucl/absmodule.dcl |  3 ++-
 sucl/absmodule.icl |  3 ++-
 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
   }
-- 
cgit v1.2.3