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