Mercurial > urweb
comparison src/cloconv.sml @ 98:dcc5dda1645c
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), |