Mercurial > urweb
diff src/monoize.sml @ 273:09c66a30ef32
Table declarations pushed to Cjr
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 02 Sep 2008 13:09:54 -0400 |
parents | 42dfb0d61cf0 |
children | e4baf03a3a64 |
line wrap: on
line diff
--- a/src/monoize.sml Tue Sep 02 11:57:25 2008 -0400 +++ b/src/monoize.sml Tue Sep 02 13:09:54 2008 -0400 @@ -1372,7 +1372,7 @@ val env' = Env.declBinds env all val d = (L'.DDatatype (x, n, map (fn (x, n, to) => (x, n, Option.map (monoType env') to)) xncs), loc) in - SOME (env', fm, d) + SOME (env', fm, [d]) end | L.DDatatype _ => poly () | L.DVal (x, n, t, e, s) => @@ -1381,7 +1381,7 @@ in SOME (Env.pushENamed env x n t NONE s, fm, - (L'.DVal (x, n, monoType env t, e, s), loc)) + [(L'.DVal (x, n, monoType env t, e, s), loc)]) end | L.DValRec vis => let @@ -1398,7 +1398,7 @@ in SOME (env, fm, - (L'.DValRec vis, loc)) + [(L'.DValRec vis, loc)]) end | L.DExport (ek, n) => let @@ -1411,19 +1411,23 @@ val ts = map (monoType env) (unwind t) in - SOME (env, fm, (L'.DExport (ek, s, n, ts), loc)) + SOME (env, fm, [(L'.DExport (ek, s, n, ts), loc)]) end - | L.DTable (x, n, _, s) => + | L.DTable (x, n, (L.CRecord (_, xts), _), s) => let val t = (L.CFfi ("Basis", "string"), loc) val t' = (L'.TFfi ("Basis", "string"), loc) val e = (L'.EPrim (Prim.String s), loc) + + val xts = map (fn (x, t) => (monoName env x, monoType env t)) xts in SOME (Env.pushENamed env x n t NONE s, fm, - (L'.DVal (x, n, t', e, s), loc)) + [(L'.DTable (s, xts), loc), + (L'.DVal (x, n, t', e, s), loc)]) end - | L.DDatabase s => SOME (env, fm, (L'.DDatabase s, loc)) + | L.DTable _ => poly () + | L.DDatabase s => SOME (env, fm, [(L'.DDatabase s, loc)]) end fun monoize env ds = @@ -1431,10 +1435,10 @@ val (_, _, ds) = List.foldl (fn (d, (env, fm, ds)) => case monoDecl (env, fm) d of NONE => (env, fm, ds) - | SOME (env, fm, d) => + | SOME (env, fm, ds') => (env, Fm.enter fm, - d :: Fm.decls fm @ ds)) + ds' @ Fm.decls fm @ ds)) (env, Fm.empty (CoreUtil.File.maxName ds + 1), []) ds in rev ds