Mercurial > urweb
comparison src/elab_util.sml @ 453:787d4931fb07
Almost have that nested save function compiling
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sat, 01 Nov 2008 21:19:43 -0400 |
parents | 85819353a84f |
children | f542bc3133dc |
comparison
equal
deleted
inserted
replaced
452:222cbc1da232 | 453:787d4931fb07 |
---|---|
373 | EUnif _ => S.return2 eAll | 373 | EUnif _ => S.return2 eAll |
374 | 374 |
375 | ELet (des, e) => | 375 | ELet (des, e) => |
376 let | 376 let |
377 val (des, ctx) = foldl (fn (ed, (des, ctx)) => | 377 val (des, ctx) = foldl (fn (ed, (des, ctx)) => |
378 (S.bind2 (des, | 378 let |
379 fn des' => | 379 val ctx' = |
380 S.map2 (mfed ctx ed, | 380 case #1 ed of |
381 EDVal (x, t, _) => bind (ctx, RelE (x, t)) | |
382 | EDValRec vis => | |
383 foldl (fn ((x, t, _), ctx) => bind (ctx, RelE (x, t))) ctx vis | |
384 in | |
385 (S.bind2 (des, | |
386 fn des' => | |
387 S.map2 (mfed ctx ed, | |
381 fn ed' => des' @ [ed'])), | 388 fn ed' => des' @ [ed'])), |
382 case #1 ed of | 389 ctx') |
383 EDVal (x, t, _) => bind (ctx, RelE (x, t)) | 390 end) |
384 | EDValRec vis => | |
385 foldl (fn ((x, t, _), env) => bind (ctx, RelE (x, t))) ctx vis)) | |
386 (S.return2 [], ctx) des | 391 (S.return2 [], ctx) des |
387 in | 392 in |
388 S.bind2 (des, | 393 S.bind2 (des, |
389 fn des' => | 394 fn des' => |
390 S.map2 (mfe ctx e, | 395 S.map2 (mfe ctx e, |
398 S.map2 (mfvi ctx vi, | 403 S.map2 (mfvi ctx vi, |
399 fn vi' => | 404 fn vi' => |
400 (EDVal vi', loc)) | 405 (EDVal vi', loc)) |
401 | EDValRec vis => | 406 | EDValRec vis => |
402 let | 407 let |
403 val ctx = foldl (fn ((x, t, _), env) => bind (ctx, RelE (x, t))) ctx vis | 408 val ctx = foldl (fn ((x, t, _), ctx) => bind (ctx, RelE (x, t))) ctx vis |
404 in | 409 in |
405 S.map2 (ListUtil.mapfold (mfvi ctx) vis, | 410 S.map2 (ListUtil.mapfold (mfvi ctx) vis, |
406 fn vis' => | 411 fn vis' => |
407 (EDValRec vis', loc)) | 412 (EDValRec vis', loc)) |
408 end | 413 end |