Mercurial > urweb

comparison src/cloconv.sml @ 29:537db4ee89f4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Translation to Cjr
author Adam Chlipala <adamc@hcoop.net>
date Tue, 10 Jun 2008 18:28:43 -0400
parents 4ab19c19665f
children 92361a008a10
comparison
equal deleted inserted replaced
28:104d43266b33 29:537db4ee89f4
113 | L.EApp (e1, e2) => 113 | L.EApp (e1, e2) =>
114 let 114 let
115 val (e1, D) = ccExp env (e1, D) 115 val (e1, D) = ccExp env (e1, D)
116 val (e2, D) = ccExp env (e2, D) 116 val (e2, D) = ccExp env (e2, D)
117 in 117 in
118 ((L'.ELet ([("closure", e1), 118 ((L'.ELet ([("closure", (L'.TTop, loc), e1),
119 ("arg", liftExpInExp 0 e2), 119 ("arg", (L'.TTop, loc), liftExpInExp 0 e2),
120 ("code", (L'.EField ((L'.ERel 1, loc), "func"), loc)), 120 ("code", (L'.TTop, loc), (L'.EField ((L'.ERel 1, loc), "func"), loc)),
121 ("env", (L'.EField ((L'.ERel 2, loc), "env"), loc))], 121 ("env", (L'.TTop, loc), (L'.EField ((L'.ERel 2, loc), "env"), loc))],
122 (L'.EApp ((L'.ERel 1, loc), 122 (L'.EApp ((L'.ERel 1, loc),
123 (L'.ERecord [("env", (L'.ERel 0, loc)), 123 (L'.ERecord [("env", (L'.ERel 0, loc), (L'.TTop, loc)),
124 ("arg", (L'.ERel 2, loc))], loc)), loc)), loc), D) 124 ("arg", (L'.ERel 2, loc), (L'.TTop, loc))], loc)), loc)), loc), D)
125 end 125 end
126 | L.EAbs (x, dom, ran, e) => 126 | L.EAbs (x, dom, ran, e) =>
127 let 127 let
128 val dom = ccTyp dom 128 val dom = ccTyp dom
129 val ran = ccTyp ran 129 val ran = ccTyp ran
143 (L'.ERel n, loc))) ns*) 143 (L'.ERel n, loc))) ns*)
144 val body = foldl (fn (n, e) => 144 val body = foldl (fn (n, e) =>
145 subExpInExp (n, (L'.EField ((L'.ERel 1, loc), "fv" ^ Int.toString n), loc)) e) 145 subExpInExp (n, (L'.EField ((L'.ERel 1, loc), "fv" ^ Int.toString n), loc)) e)
146 e ns 146 e ns
147 (*val () = Print.preface (" After", FlatPrint.p_exp FlatEnv.basis body)*) 147 (*val () = Print.preface (" After", FlatPrint.p_exp FlatEnv.basis body)*)
148 val body = (L'.ELet ([("env", (L'.EField ((L'.ERel 0, loc), "env"), loc)), 148 val body = (L'.ELet ([("env", (L'.TTop, loc), (L'.EField ((L'.ERel 0, loc), "env"), loc)),
149 ("arg", (L'.EField ((L'.ERel 1, loc), "arg"), loc))], 149 ("arg", (L'.TTop, loc), (L'.EField ((L'.ERel 1, loc), "arg"), loc))],
150 body), loc) 150 body), loc)
151 151
152 val envT = (L'.TRecord (map (fn n => ("fv" ^ Int.toString n, #2 (E.lookupERel env (n-1)))) ns), loc) 152 val envT = (L'.TRecord (map (fn n => ("fv" ^ Int.toString n, #2 (E.lookupERel env (n-1)))) ns), loc)
153 val (D, fi) = Ds.func D (x, (L'.TRecord [("env", envT), ("arg", dom)], loc), ran, body) 153 val (D, fi) = Ds.func D (x, (L'.TRecord [("env", envT), ("arg", dom)], loc), ran, body)
154 in 154 in
155 ((L'.ERecord [("code", (L'.ECode fi, loc)), 155 ((L'.ERecord [("code", (L'.ECode fi, loc), (L'.TTop, loc)),
156 ("env", (L'.ERecord (map (fn n => ("fv" ^ Int.toString n, 156 ("env", (L'.ERecord (map (fn n => ("fv" ^ Int.toString n,
157 (L'.ERel (n-1), loc))) ns), loc))], loc), D) 157 (L'.ERel (n-1), loc),
158 #2 (E.lookupERel env (n-1)))) ns), loc),
159 envT)], loc), D)
158 end 160 end
159 161
160 | L.ERecord xes => 162 | L.ERecord xes =>
161 let 163 let
162 val (xes, D) = ListUtil.foldlMap (fn ((x, e), D) => 164 val (xes, D) = ListUtil.foldlMap (fn ((x, e, t), D) =>
163 let 165 let
164 val (e, D) = ccExp env (e, D) 166 val (e, D) = ccExp env (e, D)
165 in 167 in
166 ((x, e), D) 168 ((x, e, ccTyp t), D)
167 end) D xes 169 end) D xes
168 in 170 in
169 ((L'.ERecord xes, loc), D) 171 ((L'.ERecord xes, loc), D)
170 end 172 end
171 | L.EField (e1, x) => 173 | L.EField (e1, x) =>