diff options
author | Adam Chlipala <adamc@hcoop.net> | 2008-08-09 08:47:36 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2008-08-09 08:47:36 -0400 |
commit | bd2d0fe6c8deedc88d985b2c38978b730ff0cd19 (patch) | |
tree | 2daf2365908cb5776cc09bcfc90146e1984efb6f /src/specialize.sml | |
parent | b9b67597324deb6e6dfc8ef33c60c110abc2af7b (diff) |
A multi-parameter datatype all the way through
Diffstat (limited to 'src/specialize.sml')
-rw-r--r-- | src/specialize.sml | 53 |
1 files changed, 30 insertions, 23 deletions
diff --git a/src/specialize.sml b/src/specialize.sml index 9690f6e7..c8af5199 100644 --- a/src/specialize.sml +++ b/src/specialize.sml @@ -77,10 +77,13 @@ fun considerSpecialization (st : state, n, args, dt : datatyp) = SOME dt' => (#name dt', #constructors dt', st) | NONE => let + (*val () = Print.prefaces "Args" [("args", Print.p_list (CorePrint.p_con CoreEnv.empty) args)]*) + val n' = #count st + val nxs = length args - 1 fun sub t = ListUtil.foldli (fn (i, arg, t) => - subConInCon (i, arg) t) t args + subConInCon (nxs - i, arg) t) t args val (cons, (count, cmap)) = ListUtil.foldlMap (fn ((x, n, to), (count, cmap)) => @@ -240,28 +243,32 @@ val specDecl = U.Decl.foldMap {kind = kind, con = con, exp = exp, decl = decl} fun specialize file = let fun doDecl (all as (d, _), st : state) = - case d of - DDatatype (x, n, xs, xnts) => - ([all], {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, - decls = []}) - | _ => - let - val (d, st) = specDecl st all - in - (rev (d :: #decls st), - {count = #count st, - datatypes = #datatypes st, - constructors = #constructors st, - decls = []}) - end + let + (*val () = Print.preface ("decl:", CorePrint.p_decl CoreEnv.empty all)*) + in + case d of + DDatatype (x, n, xs, xnts) => + ([all], {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, + decls = []}) + | _ => + let + val (d, st) = specDecl st all + in + (rev (d :: #decls st), + {count = #count st, + datatypes = #datatypes st, + constructors = #constructors st, + decls = []}) + end + end val (ds, _) = ListUtil.foldlMapConcat doDecl {count = U.File.maxName file + 1, |