Mercurial > urweb

comparison src/cjrize.sml @ 129:78d59cf0a0cc

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Compiled (non-mutual) 'val rec'
author Adam Chlipala <adamc@hcoop.net>
date Thu, 17 Jul 2008 11:02:10 -0400
parents 76a4d69719d8
children f0d3402184d1
comparison
equal deleted inserted replaced
128:b04f7422c832 129:78d59cf0a0cc
193 (L'.DVal (x, n, t, e), sm) 193 (L'.DVal (x, n, t, e), sm)
194 end 194 end
195 in 195 in
196 (SOME (d, loc), NONE, sm) 196 (SOME (d, loc), NONE, sm)
197 end 197 end
198 | L.DValRec _ => raise Fail "Cjrize DValRec" 198 | L.DValRec vis =>
199 let
200 val (vis, sm) = ListUtil.foldlMap
201 (fn ((x, n, t, e, _), sm) =>
202 let
203 val (t, sm) = cifyTyp (t, sm)
204
205 fun unravel (tAll as (t, _), eAll as (e, _)) =
206 case (t, e) of
207 (L'.TFun (dom, ran), L.EAbs (ax, _, _, e)) =>
208 let
209 val (args, t, e) = unravel (ran, e)
210 in
211 ((ax, dom) :: args, t, e)
212 end
213 | (L'.TFun _, _) =>
214 (ErrorMsg.errorAt loc "Function isn't explicit at code generation";
215 ([], tAll, eAll))
216 | _ => ([], tAll, eAll)
217
218 val (args, ran, e) = unravel (t, e)
219 val (e, sm) = cifyExp (e, sm)
220 in
221 ((x, n, args, ran, e), sm)
222 end)
223 sm vis
224 in
225 (SOME (L'.DFunRec vis, loc), NONE, sm)
226 end
227
199 | L.DExport (s, n, ts) => 228 | L.DExport (s, n, ts) =>
200 let 229 let
201 val (ts, sm) = ListUtil.foldlMap cifyTyp sm ts 230 val (ts, sm) = ListUtil.foldlMap cifyTyp sm ts
202 in 231 in
203 (NONE, SOME ("/" ^ s, n, ts), sm) 232 (NONE, SOME ("/" ^ s, n, ts), sm)