# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1293121411 18000
# Node ID e525ad571e155193f429d3563e284d85ad33c999
# Parent  32c8a3509369b0199eefa6c1b4b5a9c28a388064
Recursive record unification errors, for more detail

diff -r 32c8a3509369 -r e525ad571e15 include/urweb.h
--- a/include/urweb.h	Tue Dec 21 18:01:23 2010 -0500
+++ b/include/urweb.h	Thu Dec 23 11:23:31 2010 -0500
@@ -297,7 +297,7 @@
 
 failure_kind uw_runCallback(uw_context, void (*callback)(uw_context));
 
-uw_Basis_string uw_Basis_timeToStringf(uw_context, const char *fmt, uw_Basis_time);
+uw_Basis_string uw_Basis_timef(uw_context, const char *fmt, uw_Basis_time);
 uw_Basis_time uw_Basis_stringToTimef(uw_context, const char *fmt, uw_Basis_string);
 uw_Basis_time uw_Basis_stringToTimef_error(uw_context, const char *fmt, uw_Basis_string);
 
diff -r 32c8a3509369 -r e525ad571e15 lib/ur/basis.urs
--- a/lib/ur/basis.urs	Tue Dec 21 18:01:23 2010 -0500
+++ b/lib/ur/basis.urs	Thu Dec 23 11:23:31 2010 -0500
@@ -143,6 +143,7 @@
 val now : transaction time
 val minTime : time
 val minusSeconds : time -> int -> time
+val timef : string -> time -> string (* Uses strftime() format string *)
 
 
 (** HTTP operations *)
diff -r 32c8a3509369 -r e525ad571e15 src/c/urweb.c
--- a/src/c/urweb.c	Tue Dec 21 18:01:23 2010 -0500
+++ b/src/c/urweb.c	Thu Dec 23 11:23:31 2010 -0500
@@ -2582,7 +2582,7 @@
     return "<Invalid time>";
 }
 
-uw_Basis_string uw_Basis_timeToStringf(uw_context ctx, const char *fmt, uw_Basis_time t) {
+uw_Basis_string uw_Basis_timef(uw_context ctx, const char *fmt, uw_Basis_time t) {
   size_t len;
   char *r;
   struct tm stm;
diff -r 32c8a3509369 -r e525ad571e15 src/elab_err.sig
--- a/src/elab_err.sig	Tue Dec 21 18:01:23 2010 -0500
+++ b/src/elab_err.sig	Thu Dec 23 11:23:31 2010 -0500
@@ -55,7 +55,7 @@
            | CIncompatible of Elab.con * Elab.con
            | CExplicitness of Elab.con * Elab.con
            | CKindof of Elab.kind * Elab.con * string
-           | CRecordFailure of Elab.con * Elab.con * (Elab.con * Elab.con * Elab.con) option
+           | CRecordFailure of Elab.con * Elab.con * (Elab.con * Elab.con * Elab.con * cunify_error option) option
            | TooLifty of ErrorMsg.span * ErrorMsg.span
            | TooUnify of Elab.con * Elab.con
            | TooDeep
diff -r 32c8a3509369 -r e525ad571e15 src/elab_err.sml
--- a/src/elab_err.sml	Tue Dec 21 18:01:23 2010 -0500
+++ b/src/elab_err.sml	Thu Dec 23 11:23:31 2010 -0500
@@ -118,7 +118,7 @@
        | CIncompatible of con * con
        | CExplicitness of con * con
        | CKindof of kind * con * string
-       | CRecordFailure of con * con * (con * con * con) option
+       | CRecordFailure of con * con * (con * con * con * cunify_error option) option
        | TooLifty of ErrorMsg.span * ErrorMsg.span
        | TooUnify of con * con
        | TooDeep
@@ -147,15 +147,18 @@
                   [("Kind", p_kind env k),
                    ("Con", p_con env c)]
       | CRecordFailure (c1, c2, fo) =>
-        eprefaces "Can't unify record constructors"
-                  (("Summary 1", p_con env c1)
-                   :: ("Summary 2", p_con env c2)
-                   :: (case fo of
-                           NONE => []
-                         | SOME (nm, t1, t2) =>
-                           [("Field", p_con env nm),
-                            ("Value 1", p_con env t1),
-                            ("Value 2", p_con env t2)]))
+        (eprefaces "Can't unify record constructors"
+                   (("Summary 1", p_con env c1)
+                    :: ("Summary 2", p_con env c2)
+                    :: (case fo of
+                            NONE => []
+                          | SOME (nm, t1, t2, _) =>
+                            [("Field", p_con env nm),
+                             ("Value 1", p_con env t1),
+                             ("Value 2", p_con env t2)]));
+         case fo of
+             SOME (_, _, _, SOME err') => cunifyError env err'
+           | _ => ())
       | TooLifty (loc1, loc2) =>
         (ErrorMsg.errorAt loc1 "Can't unify two unification variables that both have suspended liftings";
          eprefaces' [("Other location", Print.PD.string (ErrorMsg.spanToString loc2))])
diff -r 32c8a3509369 -r e525ad571e15 src/elaborate.sml
--- a/src/elaborate.sml	Tue Dec 21 18:01:23 2010 -0500
+++ b/src/elaborate.sml	Thu Dec 23 11:23:31 2010 -0500
@@ -907,7 +907,7 @@
                              if consEq env loc (c1, c2) then
                                  findPointwise fs1
                              else
-                                 SOME (nm1, c1, c2)
+                                 SOME (nm1, c1, c2, (unifyCons env loc c1 c2; NONE) handle CUnify (_, _, err) => SOME err)
              in
                  raise CUnify' (CRecordFailure (unsummarize s1, unsummarize s2, findPointwise (#fields s1)))
              end
diff -r 32c8a3509369 -r e525ad571e15 src/sqlite.sml
--- a/src/sqlite.sml	Tue Dec 21 18:01:23 2010 -0500
+++ b/src/sqlite.sml	Thu Dec 23 11:23:31 2010 -0500
@@ -597,7 +597,7 @@
                                                      string ")"]
                                       | Time => box [string "sqlite3_bind_text(stmt, ",
                                                      string (Int.toString (i + 1)),
-                                                     string ", uw_Basis_timeToStringf(ctx, ",
+                                                     string ", uw_Basis_timef(ctx, ",
                                                      string fmt,
                                                      string ", ",
                                                      arg,