Commit 73233a80 authored by Vincent Zweije's avatar Vincent Zweije
Browse files

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

which included commits to RCS files with non-trunk default branches.
parent 2269c54d
......@@ -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
}
......@@ -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)))
*/
......@@ -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
}
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment