Mercurial > urweb
diff src/elaborate.sml @ 109:813e5a52063d
Remove closure conversion in favor of zany fun with modules, which also replaces 'page'
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 13 Jul 2008 10:17:06 -0400 |
parents | f0f59e918cac |
children | 3739af9e727a |
line wrap: on
line diff
--- a/src/elaborate.sml Thu Jul 10 16:05:14 2008 -0400 +++ b/src/elaborate.sml Sun Jul 13 10:17:06 2008 -0400 @@ -1599,7 +1599,7 @@ | L'.DStr (x, n, sgn, _) => SOME (L'.SgiStr (x, n, sgn), loc) | L'.DFfiStr (x, n, sgn) => SOME (L'.SgiStr (x, n, sgn), loc) | L'.DConstraint cs => SOME (L'.SgiConstraint cs, loc) - | L'.DPage _ => NONE + | L'.DExport _ => NONE fun sgiBindsD (env, denv) (sgi, _) = case sgi of @@ -1929,27 +1929,41 @@ ([], (env, denv, [])) end - | L.DPage e => + | L.DExport str => let - val basis = - case E.lookupStr env "Basis" of - NONE => raise Fail "elabExp: Unbound Basis" - | SOME (n, _) => n + val (str', sgn, gs) = elabStr (env, denv) str - val (e', t, gs1) = elabExp (env, denv) e - - val k = (L'.KRecord (L'.KType, loc), loc) - val vs = cunif (loc, k) - - val c = (L'.TFun ((L'.TRecord vs, loc), - (L'.CApp ((L'.CModProj (basis, [], "xml"), loc), - (L'.CRecord ((L'.KUnit, loc), - [((L'.CName "Html", loc), - (L'.CUnit, loc))]), loc)), loc)), loc) - - val gs2 = checkCon (env, denv) e' t c + val sgn = + case #1 (hnormSgn env sgn) of + L'.SgnConst sgis => + let + fun doOne (all as (sgi, _)) = + case sgi of + L'.SgiVal (x, n, t) => + (case hnormCon (env, denv) t of + ((L'.TFun (dom, ran), _), []) => + (case (hnormCon (env, denv) dom, hnormCon (env, denv) ran) of + (((L'.TRecord domR, _), []), + ((L'.CApp (tf, ranR), _), [])) => + (case hnormCon (env, denv) ranR of + (ranR, []) => + (case (hnormCon (env, denv) domR, hnormCon (env, denv) ranR) of + ((domR, []), (ranR, [])) => + (L'.SgiVal (x, n, (L'.TFun ((L'.TRecord domR, loc), + (L'.CApp (tf, + (L'.TRecord ranR, loc)), loc)), + loc)), loc) + | _ => all) + | _ => all) + | _ => all) + | _ => all) + | _ => all + in + (L'.SgnConst (map doOne sgis), loc) + end + | _ => sgn in - ([(L'.DPage (vs, e'), loc)], (env, denv, gs1 @ gs2)) + ([(L'.DExport (E.newNamed (), sgn, str'), loc)], (env, denv, gs)) end and elabStr (env, denv) (str, loc) =