Mercurial > urweb
changeset 826:78504d97410b
Fix EDLet elab_util bug
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 28 May 2009 12:40:55 -0400 |
| parents | 7f871c03e3a1 |
| children | 497c7dbcc695 |
| files | lib/ur/list.ur lib/ur/listPair.ur src/elab_util.sml src/unnest.sml |
| diffstat | 4 files changed, 59 insertions(+), 56 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/ur/list.ur Thu May 28 12:07:05 2009 -0400 +++ b/lib/ur/list.ur Thu May 28 12:40:55 2009 -0400 @@ -1,38 +1,38 @@ datatype t = datatype Basis.list -val show (a ::: Type) (_ : show a) = - let - fun show' (ls : list a) = - case ls of - [] => "[]" - | x :: ls => show x ^ " :: " ^ show' ls - in - mkShow show' - end +val show = fn [a] (_ : show a) => + let + fun show' (ls : list a) = + case ls of + [] => "[]" + | x :: ls => show x ^ " :: " ^ show' ls + in + mkShow show' + end -val rev (a ::: Type) = - let - fun rev' acc (ls : list a) = - case ls of - [] => acc - | x :: ls => rev' (x :: acc) ls - in - rev' [] - end +val rev = fn [a] => + let + fun rev' acc (ls : list a) = + case ls of + [] => acc + | x :: ls => rev' (x :: acc) ls + in + rev' [] + end -val revAppend (a ::: Type) = - let - fun ra (ls : list a) acc = - case ls of - [] => acc - | x :: ls => ra ls (x :: acc) - in - ra - end +val revAppend = fn [a] => + let + fun ra (ls : list a) acc = + case ls of + [] => acc + | x :: ls => ra ls (x :: acc) + in + ra + end -fun append (a ::: Type) (ls1 : t a) (ls2 : t a) = revAppend (rev ls1) ls2 +fun append [a] (ls1 : t a) (ls2 : t a) = revAppend (rev ls1) ls2 -fun mp (a ::: Type) (b ::: Type) f = +fun mp [a] [b] f = let fun mp' acc ls = case ls of @@ -42,7 +42,7 @@ mp' [] end -fun mapPartial (a ::: Type) (b ::: Type) f = +fun mapPartial [a] [b] f = let fun mp' acc ls = case ls of @@ -54,7 +54,7 @@ mp' [] end -fun mapX (a ::: Type) (ctx ::: {Unit}) f = +fun mapX [a] [ctx ::: {Unit}] f = let fun mapX' ls = case ls of @@ -64,7 +64,7 @@ mapX' end -fun mapM (m ::: (Type -> Type)) (_ : monad m) (a ::: Type) (b ::: Type) f = +fun mapM [m ::: (Type -> Type)] (_ : monad m) [a] [b] f = let fun mapM' acc ls = case ls of @@ -74,7 +74,7 @@ mapM' [] end -fun filter (a ::: Type) f = +fun filter [a] f = let fun fil acc ls = case ls of @@ -84,7 +84,7 @@ fil [] end -fun exists (a ::: Type) f = +fun exists [a] f = let fun ex ls = case ls of @@ -98,7 +98,7 @@ ex end -fun foldlMap (a ::: Type) (b ::: Type) (c ::: Type) f = +fun foldlMap [a] [b] [c] f = let fun fold ls' st ls = case ls of
--- a/lib/ur/listPair.ur Thu May 28 12:07:05 2009 -0400 +++ b/lib/ur/listPair.ur Thu May 28 12:40:55 2009 -0400 @@ -1,4 +1,4 @@ -fun mapX (a ::: Type) (b ::: Type) (ctx ::: {Unit}) f = +fun mapX [a] [b] [ctx ::: {Unit}] f = let fun mapX' ls1 ls2 = case (ls1, ls2) of
--- a/src/elab_util.sml Thu May 28 12:07:05 2009 -0400 +++ b/src/elab_util.sml Thu May 28 12:40:55 2009 -0400 @@ -438,29 +438,30 @@ | 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 @@ 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 =>
--- a/src/unnest.sml Thu May 28 12:07:05 2009 -0400 +++ b/src/unnest.sml Thu May 28 12:40:55 2009 -0400 @@ -241,10 +241,12 @@ 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