diff options
author | Adam Chlipala <adamc@hcoop.net> | 2008-07-13 10:17:06 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2008-07-13 10:17:06 -0400 |
commit | 3316f3c317e587a5fc2ecf38f061a72b48e3b94e (patch) | |
tree | fae8c92c195e5f7976352a337017d285e729f859 /src/corify.sml | |
parent | 7281dbb2fc2a5f50c1049bad629f330e2ff3f7ca (diff) |
Remove closure conversion in favor of zany fun with modules, which also replaces 'page'
Diffstat (limited to 'src/corify.sml')
-rw-r--r-- | src/corify.sml | 72 |
1 files changed, 57 insertions, 15 deletions
diff --git a/src/corify.sml b/src/corify.sml index 43acedfc..faeda0d1 100644 --- a/src/corify.sml +++ b/src/corify.sml @@ -362,6 +362,7 @@ fun corifyExp st (e, loc) = | L.EField (e1, c, {field, rest}) => (L'.EField (corifyExp st e1, corifyCon st c, {field = corifyCon st field, rest = corifyCon st rest}), loc) | L.EFold k => (L'.EFold (corifyKind k), loc) + | L.EWrite e => (L'.EWrite (corifyExp st e), loc) fun corifyDecl ((d, loc : EM.span), st) = case d of @@ -375,7 +376,7 @@ fun corifyDecl ((d, loc : EM.span), st) = let val (st, n) = St.bindVal st x n in - ([(L'.DVal (x, n, corifyCon st t, corifyExp st e), loc)], st) + ([(L'.DVal (x, n, corifyCon st t, corifyExp st e, x), loc)], st) end | L.DSgn _ => ([], st) @@ -427,19 +428,60 @@ fun corifyDecl ((d, loc : EM.span), st) = end | _ => raise Fail "Non-const signature for FFI structure") - | L.DPage (c, e) => - let - val c = corifyCon st c - val e = corifyExp st e - - val dom = (L'.TRecord c, loc) - val ran = (L'.TRecord (L'.CRecord ((L'.KType, loc), []), loc), loc) - val e = (L'.EAbs ("vs", dom, ran, - (L'.EWrite (L'.EApp (e, (L'.ERel 0, loc)), loc), loc)), loc) - - in - ([(L'.DPage (c, e), loc)], st) - end + | L.DExport (en, sgn, str) => + (case #1 sgn of + L.SgnConst sgis => + let + fun pathify (str, _) = + case str of + L.StrVar m => SOME (m, []) + | L.StrProj (str, s) => + Option.map (fn (m, ms) => (m, ms @ [s])) (pathify str) + | _ => NONE + in + case pathify str of + NONE => (ErrorMsg.errorAt loc "Structure is too fancy to export"; + ([], st)) + | SOME (m, ms) => + let + fun wrapSgi ((sgi, _), (wds, eds)) = + case sgi of + L.SgiVal (s, _, t as (L.TFun (dom, ran), _)) => + (case (#1 dom, #1 ran) of + (L.TRecord _, + L.CApp ((L.CModProj (_, [], "xml"), _), + (L.TRecord (L.CRecord (_, [((L.CName "Html", _), + _)]), _), _))) => + let + val ran = (L.TRecord (L.CRecord ((L.KType, loc), []), loc), loc) + val e = (L.EModProj (m, ms, s), loc) + val e = (L.EAbs ("vs", dom, ran, + (L.EWrite (L.EApp (e, (L.ERel 0, loc)), loc), loc)), loc) + in + ((L.DVal ("wrap_" ^ s, 0, + (L.TFun (dom, ran), loc), + e), loc) :: wds, + (fn st => + case #1 (corifyExp st (L.EModProj (en, [], "wrap_" ^ s), loc)) of + L'.ENamed n => (L'.DExport n, loc) + | _ => raise Fail "Corify: Value to export didn't corify properly") + :: eds) + end + | _ => (wds, eds)) + | _ => (wds, eds) + + val (wds, eds) = foldl wrapSgi ([], []) sgis + val wrapper = (L.StrConst wds, loc) + val (ds, {inner, outer}) = corifyStr (wrapper, st) + val st = St.bindStr outer "wrapper" en inner + + val ds = ds @ map (fn f => f st) eds + in + (ds, st) + end + end + | _ => raise Fail "Non-const signature for 'export'") + and corifyStr ((str, _), st) = case str of @@ -487,7 +529,7 @@ fun maxName ds = foldl (fn ((d, _), n) => | L.DSgn (_, n', _) => Int.max (n, n') | L.DStr (_, n', _, str) => Int.max (n, Int.max (n', maxNameStr str)) | L.DFfiStr (_, n', _) => Int.max (n, n') - | L.DPage _ => n) + | L.DExport _ => n) 0 ds and maxNameStr (str, _) = |