diff src/elaborate.sml @ 1588:65d6488c82d5

Fix confusing error message when record unification fails because enclosed types are incompatible
author Adam Chlipala <adam@chlipala.net>
date Sat, 05 Nov 2011 09:56:52 -0400
parents 03ad79980b55
children fb0388f1180e
line wrap: on
line diff
--- a/src/elaborate.sml	Sat Nov 05 09:40:38 2011 -0400
+++ b/src/elaborate.sml	Sat Nov 05 09:56:52 2011 -0400
@@ -919,7 +919,9 @@
                              if consEq env loc (c1, c2) then
                                  findPointwise fs1
                              else
-                                 SOME (nm1, c1, c2, (unifyCons env loc c1 c2; NONE) handle CUnify (_, _, err) => SOME err)
+                                 SOME (nm1, c1, c2, (unifyCons env loc c1 c2; NONE)
+                                                    handle CUnify (_, _, err) => (reducedSummaries := NONE;
+                                                                                  SOME err))
              in
                  raise CUnify' (CRecordFailure (unsummarize s1, unsummarize s2, findPointwise (#fields s1)))
              end
@@ -939,7 +941,8 @@
                   val c = summaryToCon {fields = fs1, unifs = unifs1, others = others1}
               in
                   if occursCon r c then
-                      raise CUnify' (COccursCheckFailed (cr, c))
+                      (reducedSummaries := NONE;
+                       raise CUnify' (COccursCheckFailed (cr, c)))
                   else
                       (r := SOME (squish nl c))
                       handle CantSquish => default ()
@@ -949,7 +952,8 @@
                   val c = summaryToCon {fields = fs2, unifs = unifs2, others = others2}
               in
                   if occursCon r c then
-                      raise CUnify' (COccursCheckFailed (cr, c))
+                      (reducedSummaries := NONE;
+                       raise CUnify' (COccursCheckFailed (cr, c)))
                   else
                       (r := SOME (squish nl c))
                       handle CantSquish => default ()