This commit was generated by cvs2svn to compensate for changes in r664,

which included commits to RCS files with non-trunk default branches.

git-svn-id: https://svn.cs.ru.nl/repos/clean-compiler/trunk@665 1f8540f1-abd5-4d5b-9d24-4c5ce8603e2d

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
+  }