# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1226178179 18000
# Node ID 40c7379130754f3a50f113e4fd82b91df8ff949a
# Parent  ffa18975e661e3309b918aae03f9ad3c2b4a90fa
Especialize handles records better

diff -r ffa18975e661 -r 40c737913075 src/core_print.sml
--- a/src/core_print.sml	Sat Nov 08 14:42:52 2008 -0500
+++ b/src/core_print.sml	Sat Nov 08 16:02:59 2008 -0500
@@ -93,7 +93,7 @@
               string (#1 (E.lookupCNamed env n) ^ "__" ^ Int.toString n)
           else
               string (#1 (E.lookupCNamed env n)))
-         handle E.UnboundNamed _ => string ("UNBOUNDN_" ^ Int.toString n))
+        handle E.UnboundNamed _ => string ("UNBOUNDN_" ^ Int.toString n))
       | CFfi (m, x) => box [string "FFI(", string m, string ".", string x, string ")"]
 
       | CApp (c1, c2) => parenIf par (box [p_con env c1,
diff -r ffa18975e661 -r 40c737913075 src/corify.sml
--- a/src/corify.sml	Sat Nov 08 14:42:52 2008 -0500
+++ b/src/corify.sml	Sat Nov 08 16:02:59 2008 -0500
@@ -387,7 +387,7 @@
 
 fun lookupStrById ({basis, strs, ...} : t) n =
     case IM.find (strs, n) of
-        NONE => raise Fail "Corify.St.lookupStrById"
+        NONE => raise Fail ("Corify.St.lookupStrById(" ^ Int.toString n ^ ")")
       | SOME f => dummy (basis, f)
 
 fun lookupStrByName (m, {basis, current = FNormal {strs, ...}, ...} : t) =
@@ -602,7 +602,7 @@
 
       | L.ELet (x, t, e1, e2) => (L'.ELet (x, corifyCon st t, corifyExp st e1, corifyExp st e2), loc)
 
-fun corifyDecl mods ((d, loc : EM.span), st) =
+fun corifyDecl mods (all as (d, loc : EM.span), st) =
     case d of
         L.DCon (x, n, k, c) =>
         let
diff -r ffa18975e661 -r 40c737913075 src/elaborate.sml
--- a/src/elaborate.sml	Sat Nov 08 14:42:52 2008 -0500
+++ b/src/elaborate.sml	Sat Nov 08 16:02:59 2008 -0500
@@ -2615,14 +2615,14 @@
 
       | (L'.SgnFun (m1, n1, dom1, ran1), L'.SgnFun (m2, n2, dom2, ran2)) =>
         let
-            val ran1 =
+            val ran2 =
                 if n1 = n2 then
-                    ran1
+                    ran2
                 else
-                    subStrInSgn (n1, n2) ran1
+                    subStrInSgn (n2, n1) ran2
         in
             subSgn (env, denv) dom2 dom1;
-            subSgn (E.pushStrNamedAs env m2 n2 dom2, denv) ran1 ran2
+            subSgn (E.pushStrNamedAs env m1 n1 dom2, denv) ran1 ran2
         end
 
       | _ => sgnError env (SgnWrongForm (sgn1, sgn2)))
diff -r ffa18975e661 -r 40c737913075 src/especialize.sml
--- a/src/especialize.sml	Sat Nov 08 14:42:52 2008 -0500
+++ b/src/especialize.sml	Sat Nov 08 16:02:59 2008 -0500
@@ -106,6 +106,11 @@
         fun getApp e =
             case e of
                 ENamed f => SOME (f, [], [])
+              | EField ((ERecord xes, _), (CName x, _), _) =>
+                (case List.find (fn ((CName x', _), _,_) => x' = x
+                                  | _ => false) xes of
+                     NONE => NONE
+                   | SOME (_, (e, _), _) => getApp e)
               | EApp (e1, e2) =>
                 (case getApp (#1 e1) of
                      NONE => NONE
@@ -125,10 +130,18 @@
     in
         case getApp e of
             NONE => (e, st)
-          | SOME (_, [], _) => (e, st)
+          | SOME (f, [], xs') => (#1 (foldl (fn (arg, e) => (EApp (e, arg), ErrorMsg.dummySpan))
+                                            (ENamed f, ErrorMsg.dummySpan) xs'), st)
           | SOME (f, xs, xs') =>
             case IM.find (#funcs st, f) of
-                NONE => ((*print ("SHOT DOWN! " ^ Int.toString f ^ "\n");*) (e, st))
+                NONE =>
+                let
+                    val e = foldl (fn (arg, e) => (EApp (e, skeyOut arg), ErrorMsg.dummySpan))
+                                  (ENamed f, ErrorMsg.dummySpan) xs
+                in
+                    (#1 (foldl (fn (arg, e) => (EApp (e, arg), ErrorMsg.dummySpan))
+                               e xs'), st)
+                end
               | SOME {name, args, body, typ, tag} =>
                 case KM.find (args, xs) of
                     SOME f' => ((*Print.prefaces "Pre-existing" [("e", CorePrint.p_exp CoreEnv.empty (e, ErrorMsg.dummySpan))];*)
diff -r ffa18975e661 -r 40c737913075 src/expl_print.sml
--- a/src/expl_print.sml	Sat Nov 08 14:42:52 2008 -0500
+++ b/src/expl_print.sml	Sat Nov 08 16:02:59 2008 -0500
@@ -97,7 +97,7 @@
       | CModProj (m1, ms, x) =>
         let
             val m1x = #1 (E.lookupStrNamed env m1)
-                      handle E.UnboundNamed _ => "UNBOUND"
+                      handle E.UnboundNamed _ => "UNBOUND" ^ Int.toString m1
 
             val m1s = if !debug then
                           m1x ^ "__" ^ Int.toString m1
@@ -226,7 +226,7 @@
       | EModProj (m1, ms, x) =>
         let
             val (m1x, sgn) = E.lookupStrNamed env m1
-                handle E.UnboundNamed _ => ("UNBOUND", (SgnConst [], loc))
+                handle E.UnboundNamed _ => ("UNBOUND" ^ Int.toString m1, (SgnConst [], loc))
 
             val m1s = if !debug then
                           m1x ^ "__" ^ Int.toString m1
@@ -487,11 +487,11 @@
                               newline,
                               string "end"]
       | SgnVar n => string ((#1 (E.lookupSgnNamed env n))
-                            handle E.UnboundNamed _ => "UNBOUND")
+                            handle E.UnboundNamed _ => "UNBOUND" ^ Int.toString n)
       | SgnFun (x, n, sgn, sgn') => box [string "functor",
                                          space,
                                          string "(",
-                                         string x,
+                                         p_named x n,
                                          space,
                                          string ":",
                                          space,
@@ -515,7 +515,7 @@
       | SgnProj (m1, ms, x) =>
         let
             val (m1x, sgn) = E.lookupStrNamed env m1
-                handle E.UnboundNamed _ => ("UNBOUND", (SgnConst [], loc))
+                handle E.UnboundNamed _ => ("UNBOUND" ^ Int.toString m1, (SgnConst [], loc))
                              
             val m1s = if !debug then
                           m1x ^ "__" ^ Int.toString m1
@@ -643,7 +643,7 @@
       | StrVar n =>
         let
             val x = #1 (E.lookupStrNamed env n)
-                    handle E.UnboundNamed _ => "UNBOUND"
+                    handle E.UnboundNamed _ => "UNBOUND" ^ Int.toString n
 
             val s = if !debug then
                         x ^ "__" ^ Int.toString n
@@ -662,7 +662,7 @@
             box [string "functor",
                  space,
                  string "(",
-                 string x,
+                 p_named x n,
                  space,
                  string ":",
                  space,