SCM Repository
View of /sml/trunk/src/compiler/FLINT/opt/optutils.sml
Parent Directory
|
Revision Log
Revision 184 -
(download)
(annotate)
Sun Nov 8 21:18:20 1998 UTC (22 years, 4 months ago) by monnier
File size: 1411 byte(s)
Sun Nov 8 21:18:20 1998 UTC (22 years, 4 months ago) by monnier
File size: 1411 byte(s)
* added basic unrolling support * changed fkind to have most annotations valid on functors as well. It also adds a loopkind annotation as well as extends the inline boolean into a three-way alternative. * switched to a continuation passing style to implement the let-associativity rule in a better way.
(* copyright 1998 YALE FLINT PROJECT *) (* monnier@cs.yale.edu *) signature OPT_UTILS = sig datatype ('a,'b) either = A of 'a | B of 'b (* takes the fk of a function and returns the fk of the wrapper * along with the new fk of the actual body *) val fk_wrap : FLINT.fkind * FLINT.lty list option -> (FLINT.fkind * FLINT.fkind) (* sometimes I get fed up rewriting the identity function *) val id : 'a -> 'a (* this is a known APL function, but I don't know its real name *) val filter : bool list * 'a list -> 'a list end structure OptUtils :> OPT_UTILS = struct local structure F = FLINT structure LK = LtyKernel in datatype ('a,'b) either = A of 'a | B of 'b fun bug msg = ErrorMsg.impossible ("OptUtils: "^msg) fun fk_wrap ({inline,known,isrec,cconv},rtys') = let val cconv' = case cconv of F.CC_FUN(LK.FF_VAR(f1,f2)) => F.CC_FUN(LK.FF_VAR(true, f2)) | (F.CC_FCT | F.CC_FUN(LK.FF_FIXED)) => cconv val isrec' = Option.map (fn ltys => (ltys, F.LK_UNKNOWN)) rtys' in ({isrec=isrec, known=known, cconv=cconv, inline=F.IH_ALWAYS}, {isrec=isrec', known=true, cconv=cconv', inline=inline}) end fun filter ([],[]) = [] | filter (true::fs,x::xs) = x::(filter(fs, xs)) | filter (false::fs,x::xs) = (filter(fs, xs)) | filter _ = bug "unmatched list length in filter" fun id x = x end end
root@smlnj-gforge.cs.uchicago.edu | ViewVC Help |
Powered by ViewVC 1.0.0 |