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/cli.icl | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

(limited to 'sucl/cli.icl')

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