diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2008-06-10 18:28:43 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2008-06-10 18:28:43 -0400 |
| commit | c1c6013533ba8eaa3b41924bcd61d99a4da27955 (patch) | |
| tree | 21e70479e0bc1cf28935d2d80700c1c3063ddc36 /src/cloconv.sml | |
| parent | ecf88cd1a7c5d137a732c4c8eb4d34c5e845ccaf (diff) | |
Translation to Cjr
Diffstat (limited to 'src/cloconv.sml')
| -rw-r--r-- | src/cloconv.sml | 26 |
1 files changed, 14 insertions, 12 deletions
diff --git a/src/cloconv.sml b/src/cloconv.sml index fdf05363..93563010 100644 --- a/src/cloconv.sml +++ b/src/cloconv.sml @@ -115,13 +115,13 @@ fun ccExp env ((e, loc), D) = val (e1, D) = ccExp env (e1, D) val (e2, D) = ccExp env (e2, D) in - ((L'.ELet ([("closure", e1), - ("arg", liftExpInExp 0 e2), - ("code", (L'.EField ((L'.ERel 1, loc), "func"), loc)), - ("env", (L'.EField ((L'.ERel 2, loc), "env"), loc))], + ((L'.ELet ([("closure", (L'.TTop, loc), e1), + ("arg", (L'.TTop, loc), liftExpInExp 0 e2), + ("code", (L'.TTop, loc), (L'.EField ((L'.ERel 1, loc), "func"), loc)), + ("env", (L'.TTop, loc), (L'.EField ((L'.ERel 2, loc), "env"), loc))], (L'.EApp ((L'.ERel 1, loc), - (L'.ERecord [("env", (L'.ERel 0, loc)), - ("arg", (L'.ERel 2, loc))], loc)), loc)), loc), D) + (L'.ERecord [("env", (L'.ERel 0, loc), (L'.TTop, loc)), + ("arg", (L'.ERel 2, loc), (L'.TTop, loc))], loc)), loc)), loc), D) end | L.EAbs (x, dom, ran, e) => let @@ -145,25 +145,27 @@ fun ccExp env ((e, loc), D) = subExpInExp (n, (L'.EField ((L'.ERel 1, loc), "fv" ^ Int.toString n), loc)) e) e ns (*val () = Print.preface (" After", FlatPrint.p_exp FlatEnv.basis body)*) - val body = (L'.ELet ([("env", (L'.EField ((L'.ERel 0, loc), "env"), loc)), - ("arg", (L'.EField ((L'.ERel 1, loc), "arg"), loc))], + val body = (L'.ELet ([("env", (L'.TTop, loc), (L'.EField ((L'.ERel 0, loc), "env"), loc)), + ("arg", (L'.TTop, loc), (L'.EField ((L'.ERel 1, loc), "arg"), loc))], body), loc) val envT = (L'.TRecord (map (fn n => ("fv" ^ Int.toString n, #2 (E.lookupERel env (n-1)))) ns), loc) val (D, fi) = Ds.func D (x, (L'.TRecord [("env", envT), ("arg", dom)], loc), ran, body) in - ((L'.ERecord [("code", (L'.ECode fi, loc)), + ((L'.ERecord [("code", (L'.ECode fi, loc), (L'.TTop, loc)), ("env", (L'.ERecord (map (fn n => ("fv" ^ Int.toString n, - (L'.ERel (n-1), loc))) ns), loc))], loc), D) + (L'.ERel (n-1), loc), + #2 (E.lookupERel env (n-1)))) ns), loc), + envT)], loc), D) end | L.ERecord xes => let - val (xes, D) = ListUtil.foldlMap (fn ((x, e), D) => + val (xes, D) = ListUtil.foldlMap (fn ((x, e, t), D) => let val (e, D) = ccExp env (e, D) in - ((x, e), D) + ((x, e, ccTyp t), D) end) D xes in ((L'.ERecord xes, loc), D) |