Mercurial > urweb

comparison src/cloconv.sml @ 98:dcc5dda1645c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fill in more types during closure conversion
author Adam Chlipala <adamc@hcoop.net>
date Thu, 10 Jul 2008 09:10:56 -0400
parents 40d146f467c5
children f0f59e918cac
comparison
equal deleted inserted replaced
97:713e01fd7924 98:dcc5dda1645c
138 val (e, D) = ccExp (E.pushERel env x dom) (e, Ds.enter D) 138 val (e, D) = ccExp (E.pushERel env x dom) (e, Ds.enter D)
139 val ns = Ds.listUsed D 139 val ns = Ds.listUsed D
140 val ns = List.filter (fn n => n <> 0) ns 140 val ns = List.filter (fn n => n <> 0) ns
141 val D = Ds.leave D 141 val D = Ds.leave D
142 142
143 val envT = (L'.TRecord (map (fn n => ("fv" ^ Int.toString n, #2 (E.lookupERel env (n-1)))) ns), loc)
144
143 (*val () = Print.preface ("Before", FlatPrint.p_exp FlatEnv.basis e) 145 (*val () = Print.preface ("Before", FlatPrint.p_exp FlatEnv.basis e)
144 val () = List.app (fn (x, t) => preface ("Bound", box [string x, 146 val () = List.app (fn (x, t) => preface ("Bound", box [string x,
145 space, 147 space,
146 string ":", 148 string ":",
147 space, 149 space,
151 (L'.ERel n, loc))) ns*) 153 (L'.ERel n, loc))) ns*)
152 val body = foldl (fn (n, e) => 154 val body = foldl (fn (n, e) =>
153 subExpInExp (n, (L'.EField ((L'.ERel 1, loc), "fv" ^ Int.toString n), loc)) e) 155 subExpInExp (n, (L'.EField ((L'.ERel 1, loc), "fv" ^ Int.toString n), loc)) e)
154 e ns 156 e ns
155 (*val () = Print.preface (" After", FlatPrint.p_exp FlatEnv.basis body)*) 157 (*val () = Print.preface (" After", FlatPrint.p_exp FlatEnv.basis body)*)
156 val body = (L'.ELet ([("env", (L'.TTop, loc), (L'.EField ((L'.ERel 0, loc), "env"), loc)), 158 val body = (L'.ELet ([("env", envT, (L'.EField ((L'.ERel 0, loc), "env"), loc)),
157 ("arg", (L'.TTop, loc), (L'.EField ((L'.ERel 1, loc), "arg"), loc))], 159 ("arg", dom, (L'.EField ((L'.ERel 1, loc), "arg"), loc))],
158 body), loc) 160 body), loc)
159 161
160 val envT = (L'.TRecord (map (fn n => ("fv" ^ Int.toString n, #2 (E.lookupERel env (n-1)))) ns), loc) 162
161 val (D, fi) = Ds.func D (x, (L'.TRecord [("env", envT), ("arg", dom)], loc), ran, body) 163 val (D, fi) = Ds.func D (x, (L'.TRecord [("env", envT), ("arg", dom)], loc), ran, body)
162 in 164 in
163 ((L'.ERecord [("code", (L'.ECode fi, loc), (L'.TTop, loc)), 165 ((L'.ERecord [("code", (L'.ECode fi, loc), (L'.TTop, loc)),
164 ("env", (L'.ERecord (map (fn n => ("fv" ^ Int.toString n, 166 ("env", (L'.ERecord (map (fn n => ("fv" ^ Int.toString n,
165 (L'.ERel (n-1), loc), 167 (L'.ERel (n-1), loc),