# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1242306718 14400
# Node ID 6271f0e3c2720d542b84578a65ac771af049ccea
# Parent  b87e71e45536ccfca843793a47186c4e833236cd
Fix a nasty binding bug in CoreUtil

diff -r b87e71e45536 -r 6271f0e3c272 lib/ur/list.ur
--- a/lib/ur/list.ur	Thu May 14 08:15:36 2009 -0400
+++ b/lib/ur/list.ur	Thu May 14 09:11:58 2009 -0400
@@ -29,3 +29,13 @@
     in
         mp' []
     end
+
+fun mapX (a ::: Type) (ctx ::: {Unit}) f =
+    let
+        fun mapX' ls =
+            case ls of
+                [] => <xml/>
+              | x :: ls => <xml>{f x}{mapX' ls}</xml>
+    in
+        mapX'
+    end
diff -r b87e71e45536 -r 6271f0e3c272 lib/ur/list.urs
--- a/lib/ur/list.urs	Thu May 14 08:15:36 2009 -0400
+++ b/lib/ur/list.urs	Thu May 14 09:11:58 2009 -0400
@@ -6,3 +6,4 @@
 
 val mp : a ::: Type -> b ::: Type -> (a -> b) -> t a -> t b
 
+val mapX : a ::: Type -> ctx ::: {Unit} -> (a -> xml ctx [] []) -> t a -> xml ctx [] []
diff -r b87e71e45536 -r 6271f0e3c272 src/core_print.sml
--- a/src/core_print.sml	Thu May 14 08:15:36 2009 -0400
+++ b/src/core_print.sml	Thu May 14 09:11:58 2009 -0400
@@ -198,12 +198,18 @@
 fun p_patCon env pc =
     case pc of
         PConVar n => p_con_named env n
-      | PConFfi {mod = m, con, arg, ...} =>
+      | PConFfi {mod = m, con, arg, params, ...} =>
         if !debug then
             box [string "FFIC[",
                  case arg of
                      NONE => box []
-                   | SOME t => p_con env t,
+                   | SOME t =>
+                     let
+                         val k = (KType, ErrorMsg.dummySpan)
+                         val env' = foldl (fn (x, env) => E.pushCRel env x k) env params
+                     in
+                         p_con env' t
+                     end,
                  string "](",
                  string m,
                  string ".",
diff -r b87e71e45536 -r 6271f0e3c272 src/core_util.sml
--- a/src/core_util.sml	Thu May 14 08:15:36 2009 -0400
+++ b/src/core_util.sml	Thu May 14 09:11:58 2009 -0400
@@ -772,7 +772,13 @@
               | PConFfi {mod = m, datatyp, params, con, arg, kind} =>
                 S.map2 ((case arg of
                              NONE => S.return2 NONE
-                           | SOME c => S.map2 (mfc ctx c, SOME)),
+                           | SOME c =>
+                             let
+                                 val k = (KType, ErrorMsg.dummySpan)
+                                 val ctx' = foldl (fn (x, ctx) => bind (ctx, RelC (x, k))) ctx params
+                             in
+                                 S.map2 (mfc ctx' c, SOME)
+                             end),
                         fn arg' =>
                            PConFfi {mod = m, datatyp = datatyp, params = params,
                                     con = con, arg = arg', kind = kind})
diff -r b87e71e45536 -r 6271f0e3c272 src/expl_print.sml
--- a/src/expl_print.sml	Thu May 14 08:15:36 2009 -0400
+++ b/src/expl_print.sml	Thu May 14 09:11:58 2009 -0400
@@ -219,9 +219,19 @@
       | PVar (s, _) => string s
       | PPrim p => Prim.p_t p
       | PCon (_, pc, _, NONE) => p_patCon env pc
-      | PCon (_, pc, _, SOME p) => parenIf par (box [p_patCon env pc,
-                                                     space,
-                                                     p_pat' true env p])
+      | PCon (_, pc, cs, SOME p) =>
+        if !debug then
+            parenIf par (box [p_patCon env pc,
+                              string "[",
+                              p_list (p_con env) cs,
+                              string "]",
+                              space,
+                              p_pat' true env p])
+        else
+            parenIf par (box [p_patCon env pc,
+                              space,
+                              p_pat' true env p])
+
       | PRecord xps =>
         box [string "{",
              p_list_sep (box [string ",", space]) (fn (x, p, _) =>
diff -r b87e71e45536 -r 6271f0e3c272 src/unpoly.sml
--- a/src/unpoly.sml	Thu May 14 08:15:36 2009 -0400
+++ b/src/unpoly.sml	Thu May 14 09:11:58 2009 -0400
@@ -138,14 +138,7 @@
                                                 in
                                                     trim (t, e, cargs)
                                                 end
-                                              | (_, _, []) =>
-                                                (*let
-                                                    val e = foldl (fn ((_, n, n_old, _, _, _), e) =>
-                                                                      unpolyNamed (n_old, ENamed n) e)
-                                                                  e vis
-                                                in*)
-                                                    SOME (t, e)
-                                                (*end*)
+                                              | (_, _, []) => SOME (t, e)
                                               | _ => NONE
                                     in
                                         (*Print.prefaces "specialize"
diff -r b87e71e45536 -r 6271f0e3c272 tests/pathmap.ur
--- a/tests/pathmap.ur	Thu May 14 08:15:36 2009 -0400
+++ b/tests/pathmap.ur	Thu May 14 09:11:58 2009 -0400
@@ -4,5 +4,6 @@
 fun main () : transaction page = return <xml><body>
   {[x]}<br/>
   {[y]}<br/>
-  {[Aux.hello]}
+  {[Aux.hello]}<br/>
+  {List.mapX (fn n => <xml>{[n]}!</xml>) x}
 </body></xml>