Mercurial > urweb
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} = |