diff options
| author |  Adam Chlipala <adamc@hcoop.net> | 2009-05-28 12:40:55 -0400 |
|---|---|---|
| committer | Adam Chlipala <adamc@hcoop.net> | 2009-05-28 12:40:55 -0400 |
| commit | bdd17680e61ac36aeefdbde7444381192127fe49 (patch) | |
| tree | 1ebd4c0f5a8f22a6ddd0dbb86cd2cc741b610e0e /src | |
| parent | 596bf8121cb42b4db71d0cdec9c2260d33391d8c (diff) | |
Fix EDLet elab_util bug
Diffstat (limited to 'src')
| -rw-r--r-- | src/elab_util.sml | 35 | ||||
| -rw-r--r-- | src/unnest.sml | 8 |
2 files changed, 23 insertions, 20 deletions
diff --git a/src/elab_util.sml b/src/elab_util.sml index c2101ae3..8082cb1e 100644 --- a/src/elab_util.sml +++ b/src/elab_util.sml @@ -438,29 +438,30 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, bind} = | ELet (des, e, t) => let - val (des, ctx) = foldl (fn (ed, (des, ctx)) => - let - val ctx' = - case #1 ed of - EDVal (p, _, _) => doVars (p, ctx) - | EDValRec vis => - foldl (fn ((x, t, _), ctx) => bind (ctx, RelE (x, t))) ctx vis - in - (S.bind2 (des, - fn des' => - S.map2 (mfed ctx ed, - fn ed' => des' @ [ed'])), - ctx') - end) + val (des, ctx') = foldl (fn (ed, (des, ctx)) => + let + val ctx' = + case #1 ed of + EDVal (p, _, _) => doVars (p, ctx) + | EDValRec vis => + foldl (fn ((x, t, _), ctx) => bind (ctx, RelE (x, t))) + ctx vis + in + (S.bind2 (des, + fn des' => + S.map2 (mfed ctx ed, + fn ed' => ed' :: des')), + ctx') + end) (S.return2 [], ctx) des in S.bind2 (des, fn des' => - S.bind2 (mfe ctx e, + S.bind2 (mfe ctx' e, fn e' => S.map2 (mfc ctx t, fn t' => - (ELet (des', e', t'), loc)))) + (ELet (rev des', e', t'), loc)))) end | EKAbs (x, e) => @@ -479,7 +480,7 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, bind} = EDVal (p, t, e) => S.bind2 (mfc ctx t, fn t' => - S.map2 (mfe (doVars (p, ctx)) e, + S.map2 (mfe ctx e, fn e' => (EDVal (p, t', e'), loc))) | EDValRec vis => diff --git a/src/unnest.sml b/src/unnest.sml index 3dfa741d..e0245c6f 100644 --- a/src/unnest.sml +++ b/src/unnest.sml @@ -241,10 +241,12 @@ fun exp ((ks, ts), e as old, st : state) = end) (IS.empty, IS.empty) vis - (*val () = print ("A: " ^ Int.toString (length ts) ^ ", " ^ Int.toString (length ks) ^ "\n") - val () = app (fn (x, t) => + (*val () = Print.prefaces "Letto" [("e", ElabPrint.p_exp E.empty (old, ErrorMsg.dummySpan))]*) + (*val () = print ("A: " ^ Int.toString (length ts) ^ ", " ^ Int.toString (length ks) ^ "\n")*) + (*val () = app (fn (x, t) => Print.prefaces "Var" [("x", Print.PD.string x), - ("t", ElabPrint.p_con E.empty t)]) ts*) + ("t", ElabPrint.p_con E.empty t)]) ts + val () = IS.app (fn n => print ("Free: " ^ Int.toString n ^ "\n")) efv*) val cfv = IS.foldl (fn (x, cfv) => let |