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