Mercurial > urweb
comparison src/cloconv.sml @ 100:f0f59e918cac
page declaration, up through monoize
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 10 Jul 2008 10:11:35 -0400 |
parents | dcc5dda1645c |
children | 717b6f8d8505 |
comparison
equal
deleted
inserted
replaced
99:5182f0c80d2e | 100:f0f59e918cac |
---|---|
156 e ns | 156 e ns |
157 (*val () = Print.preface (" After", FlatPrint.p_exp FlatEnv.basis body)*) | 157 (*val () = Print.preface (" After", FlatPrint.p_exp FlatEnv.basis body)*) |
158 val body = (L'.ELet ([("env", envT, (L'.EField ((L'.ERel 0, loc), "env"), loc)), | 158 val body = (L'.ELet ([("env", envT, (L'.EField ((L'.ERel 0, loc), "env"), loc)), |
159 ("arg", dom, (L'.EField ((L'.ERel 1, loc), "arg"), loc))], | 159 ("arg", dom, (L'.EField ((L'.ERel 1, loc), "arg"), loc))], |
160 body), loc) | 160 body), loc) |
161 | |
162 | 161 |
163 val (D, fi) = Ds.func D (x, (L'.TRecord [("env", envT), ("arg", dom)], loc), ran, body) | 162 val (D, fi) = Ds.func D (x, (L'.TRecord [("env", envT), ("arg", dom)], loc), ran, body) |
164 in | 163 in |
165 ((L'.ERecord [("code", (L'.ECode fi, loc), (L'.TTop, loc)), | 164 ((L'.ERecord [("code", (L'.ECode fi, loc), (L'.TTop, loc)), |
166 ("env", (L'.ERecord (map (fn n => ("fv" ^ Int.toString n, | 165 ("env", (L'.ERecord (map (fn n => ("fv" ^ Int.toString n, |
196 val t = ccTyp t | 195 val t = ccTyp t |
197 val (e, D) = ccExp E.empty (e, D) | 196 val (e, D) = ccExp E.empty (e, D) |
198 in | 197 in |
199 Ds.exp D (x, n, t, e) | 198 Ds.exp D (x, n, t, e) |
200 end | 199 end |
200 | L.DPage _ => raise Fail "Cloconv DPage" | |
201 | 201 |
202 fun cloconv ds = | 202 fun cloconv ds = |
203 let | 203 let |
204 val D = foldl ccDecl Ds.empty ds | 204 val D = foldl ccDecl Ds.empty ds |
205 in | 205 in |