Especialize handles records better

5 files changed, 29 insertions, 16 deletions

diff --git a/src/core_print.sml b/src/core_print.sml
index 7de31568..c4341e51 100644
--- a/src/core_print.sml
+++ b/src/core_print.sml
@@ -93,7 +93,7 @@ fun p_con' par env (c, _) =
               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 --git a/src/corify.sml b/src/corify.sml
index 2b90a8f0..fdb4e7b7 100644
--- a/src/corify.sml
+++ b/src/corify.sml
@@ -387,7 +387,7 @@ fun bindStr ({basis, cons, constructors, vals, strs, funs,
 
 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 @@ fun corifyExp st (e, loc) =
 
       | 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 --git a/src/elaborate.sml b/src/elaborate.sml
index 17133d93..70429c1b 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -2615,14 +2615,14 @@ fun subSgn (env, denv) sgn1 (sgn2 as (_, loc2)) =
 
       | (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 --git a/src/especialize.sml b/src/especialize.sml
index adb444b5..92e29da3 100644
--- a/src/especialize.sml
+++ b/src/especialize.sml
@@ -106,6 +106,11 @@ fun exp (e, st : state) =
         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 @@ fun exp (e, st : state) =
     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 --git a/src/expl_print.sml b/src/expl_print.sml
index 2d41ab34..e3153ef2 100644
--- a/src/expl_print.sml
+++ b/src/expl_print.sml
@@ -97,7 +97,7 @@ fun p_con' par env (c, _) =
       | 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 @@ fun p_exp' par env (e, loc) =
       | 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 @@ and p_sgn env (sgn, loc) =
                               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 @@ and p_sgn env (sgn, loc) =
       | 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 @@ and p_str env (str, _) =
       | 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 @@ and p_str env (str, _) =
             box [string "functor",
                  space,
                  string "(",
-                 string x,
+                 p_named x n,
                  space,
                  string ":",
                  space,