diff options
author | Adam Chlipala <adamc@hcoop.net> | 2009-06-09 18:11:59 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2009-06-09 18:11:59 -0400 |
commit | b7de8e9ac590f9d06df72d22489375b33a6efef9 (patch) | |
tree | fdefe678f8d11c1efad8dbe6d535da8ccb531f59 /src/specialize.sml | |
parent | 4c8297c1f381599333e998da585f4ef5ac24383b (diff) |
Some standard library reorgs and additions; handle mutual datatypes better in Specialize
Diffstat (limited to 'src/specialize.sml')
-rw-r--r-- | src/specialize.sml | 43 |
1 files changed, 26 insertions, 17 deletions
diff --git a/src/specialize.sml b/src/specialize.sml index b0e0aeae..b740ec8c 100644 --- a/src/specialize.sml +++ b/src/specialize.sml @@ -61,7 +61,7 @@ type state = { count : int, datatypes : datatyp IM.map, constructors : int IM.map, - decls : decl list + decls : (string * int * string list * (string * int * con option) list) list } fun kind (k, st) = (k, st) @@ -115,15 +115,15 @@ fun considerSpecialization (st : state, n, args, dt : datatyp) = ((x, n, SOME t), st) end) st cons - val d = (DDatatype [(#name dt ^ "_s", - n', - [], - cons)], #2 (List.hd args)) + val dt = (#name dt ^ "_s", + n', + [], + cons) in (n', cmap, {count = #count st, datatypes = #datatypes st, constructors = #constructors st, - decls = d :: #decls st}) + decls = dt :: #decls st}) end and con (c, st : state) = @@ -246,22 +246,31 @@ fun specialize file = let (*val () = Print.preface ("decl:", CorePrint.p_decl CoreEnv.empty all)*) val (d, st) = specDecl st d + + val ds = + case #decls st of + [] => [] + | dts => [(DDatatype dts, #2 d)] in case #1 d of - DDatatype [(x, n, xs, xnts)] => - (rev (d :: #decls st), + DDatatype dts => + (rev (d :: ds), {count = #count st, - datatypes = IM.insert (#datatypes st, n, - {name = x, - params = length xs, - constructors = xnts, - specializations = CM.empty}), - constructors = foldl (fn ((_, n', _), constructors) => - IM.insert (constructors, n', n)) - (#constructors st) xnts, + datatypes = foldl (fn ((x, n, xs, xnts), dts) => + IM.insert (dts, n, + {name = x, + params = length xs, + constructors = xnts, + specializations = CM.empty})) + (#datatypes st) dts, + constructors = foldl (fn ((x, n, xs, xnts), cs) => + foldl (fn ((_, n', _), constructors) => + IM.insert (constructors, n', n)) + cs xnts) + (#constructors st) dts, decls = []}) | _ => - (rev (d :: #decls st), + (rev (d :: ds), {count = #count st, datatypes = #datatypes st, constructors = #constructors st, |