# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1335961410 14400
# Node ID ec47f49c6aa34dcbc63f7ef0b7de367ca4c642cf
# Parent  d2b3fada532e5b410cd99e6800f341b7955fad93
In simplifying constructors for error messages, unfold constructor synonyms from modules

diff -r d2b3fada532e -r ec47f49c6aa3 src/elab_ops.sml
--- a/src/elab_ops.sml	Sun Apr 29 20:37:45 2012 -0400
+++ b/src/elab_ops.sml	Wed May 02 08:23:30 2012 -0400
@@ -336,7 +336,21 @@
         (case E.lookupCNamed env xn of
              (_, _, SOME c') => reduceCon env c'
            | _ => cAll)
-      | CModProj _ => cAll
+      | CModProj (n, ms, x) =>
+        let
+            val (_, sgn) = E.lookupStrNamed env n
+            val (str, sgn) = foldl (fn (m, (str, sgn)) =>
+                                       case E.projectStr env {sgn = sgn, str = str, field = m} of
+                                           NONE => raise Fail "reduceCon: Unknown substructure"
+                                         | SOME sgn => ((StrProj (str, m), loc), sgn))
+                                   ((StrVar n, loc), sgn) ms
+        in
+            case E.projectCon env {sgn = sgn, str = str, field = x} of
+                NONE => raise Fail "reduceCon: kindof: Unknown con in structure"
+              | SOME (_, NONE) => cAll
+              | SOME (_, SOME c) => reduceCon env c
+        end
+
       | CApp (c1, c2) =>
         let
             val c1 = reduceCon env c1
diff -r d2b3fada532e -r ec47f49c6aa3 tests/tcsimp.ur
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/tcsimp.ur	Wed May 02 08:23:30 2012 -0400
@@ -0,0 +1,3 @@
+val x : $(mapU string [A, B]) = {A = "hi", B = "bye"}
+
+val y = show x