comparison src/elab_util.sml @ 447:b77863cd0be2

Elaborating 'let'
author Adam Chlipala <adamc@hcoop.net>
date Sat, 01 Nov 2008 11:17:29 -0400
parents dfc8c991abd0
children 85819353a84f
comparison
equal deleted inserted replaced
446:86c063fedc4d 447:b77863cd0be2
350 (ECase (e', pes', {disc = disc', result = result'}), loc))))) 350 (ECase (e', pes', {disc = disc', result = result'}), loc)))))
351 351
352 | EError => S.return2 eAll 352 | EError => S.return2 eAll
353 | EUnif (ref (SOME e)) => mfe ctx e 353 | EUnif (ref (SOME e)) => mfe ctx e
354 | EUnif _ => S.return2 eAll 354 | EUnif _ => S.return2 eAll
355
356 | ELet (des, e) =>
357 let
358 val (des, ctx) = foldl (fn (ed, (des, ctx)) =>
359 (S.bind2 (des,
360 fn des' =>
361 S.map2 (mfed ctx ed,
362 fn ed' => des' @ [ed'])),
363 case #1 ed of
364 EDVal (x, t, _) => bind (ctx, RelE (x, t))
365 | EDValRec vis =>
366 foldl (fn ((x, t, _), env) => bind (ctx, RelE (x, t))) ctx vis))
367 (S.return2 [], ctx) des
368 in
369 S.bind2 (des,
370 fn des' =>
371 S.map2 (mfe ctx e,
372 fn e' =>
373 (ELet (des', e'), loc)))
374 end
375
376 and mfed ctx (dAll as (d, loc)) =
377 case d of
378 EDVal vi =>
379 S.map2 (mfvi ctx vi,
380 fn vi' =>
381 (EDVal vi', loc))
382 | EDValRec vis =>
383 let
384 val ctx = foldl (fn ((x, t, _), env) => bind (ctx, RelE (x, t))) ctx vis
385 in
386 S.map2 (ListUtil.mapfold (mfvi ctx) vis,
387 fn vis' =>
388 (EDValRec vis', loc))
389 end
390
391 and mfvi ctx (x, c, e) =
392 S.bind2 (mfc ctx c,
393 fn c' =>
394 S.map2 (mfe ctx e,
395 fn e' =>
396 (x, c', e')))
355 in 397 in
356 mfe 398 mfe
357 end 399 end
358 400
359 fun mapfold {kind = fk, con = fc, exp = fe} = 401 fun mapfold {kind = fk, con = fc, exp = fe} =