Mercurial > urweb
diff src/monoize.sml @ 1713:1b3f82b09bb0
Fix monoization of recursive variants
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Mon, 16 Apr 2012 09:07:28 -0400 |
| parents | 355dc023fbb8 |
| children | 95d3b4f26f59 |
line wrap: on
line diff
--- a/src/monoize.sml Wed Apr 11 03:05:26 2012 +0400 +++ b/src/monoize.sml Mon Apr 16 09:07:28 2012 -0400 @@ -52,7 +52,7 @@ val nextPvar = ref 0 val pvars = ref (RM.empty : (int * (string * int * L'.typ) list) RM.map) -val pvarDefs = ref ([] : L'.decl list) +val pvarDefs = ref ([] : (string * int * (string * int * L'.typ option) list) list) val pvarOldDefs = ref ([] : (int * (string * int * L.con option) list) list) fun choosePvar () = @@ -74,7 +74,7 @@ SM.insert (fs', x, n))) ([], SM.empty) (r, fs) in pvars := RM.insert (!pvars, r', (n, fs)); - pvarDefs := (L'.DDatatype [("$poly" ^ Int.toString n, n, map (fn (x, n, t) => (x, n, SOME t)) fs)], loc) + pvarDefs := ("$poly" ^ Int.toString n, n, map (fn (x, n, t) => (x, n, SOME t)) fs) :: !pvarDefs; pvarOldDefs := (n, r) :: !pvarOldDefs; (n, fs) @@ -532,12 +532,11 @@ fun makeDecl n fm = let val (x, xncs) = - case ListUtil.search (fn (L'.DDatatype [(x, i', xncs)], _) => + case ListUtil.search (fn (x, i', xncs) => if i' = i then SOME (x, xncs) else - NONE - | _ => NONE) (!pvarDefs) of + NONE) (!pvarDefs) of NONE => let val (x, _, xncs) = Env.lookupDatatype env i @@ -4361,7 +4360,11 @@ cs)], loc)) env (!pvarOldDefs), Fm.enter fm, - ds' @ Fm.decls fm @ !pvarDefs @ ds))) + case ds' of + [(L'.DDatatype dts, loc)] => + (L'.DDatatype (dts @ !pvarDefs), loc) :: Fm.decls fm @ ds + | _ => + ds' @ Fm.decls fm @ (L'.DDatatype (!pvarDefs), loc) :: ds))) (env, Fm.empty mname, []) file in pvars := RM.empty;