summaryrefslogtreecommitdiff
path: root/src/elaborate.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2009-12-13 11:28:47 -0500
committerGravatar Adam Chlipala <adamc@hcoop.net>2009-12-13 11:28:47 -0500
commitfed3ed6ec617bbfcabcd2a4aab2b6ee6e9571c86 (patch)
tree9f62f93b72fdb9bde85a08f36a3250c160353c54 /src/elaborate.sml
parent26648546e656337366f5cf2562fb6bcbe08a06c8 (diff)
Better record summary error messages; more tweaking SQL usability
Diffstat (limited to 'src/elaborate.sml')
-rw-r--r--src/elaborate.sml19
1 files changed, 18 insertions, 1 deletions
diff --git a/src/elaborate.sml b/src/elaborate.sml
index eccc4840..71842ec2 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -817,7 +817,24 @@
("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*)
val empty = (L'.CRecord (k, []), loc)
- fun failure () = raise CUnify' (CRecordFailure (unsummarize s1, unsummarize s2))
+ fun failure () =
+ let
+ val fs2 = #fields s2
+
+ fun findPointwise fs1 =
+ case fs1 of
+ [] => NONE
+ | (nm1, c1) :: fs1 =>
+ case List.find (fn (nm2, _) => consEq env loc (nm1, nm2)) fs2 of
+ NONE => findPointwise fs1
+ | SOME (_, c2) =>
+ if consEq env loc (c1, c2) then
+ findPointwise fs1
+ else
+ SOME (nm1, c1, c2)
+ in
+ raise CUnify' (CRecordFailure (unsummarize s1, unsummarize s2, findPointwise (#fields s1)))
+ end
in
(case (unifs1, fs1, others1, unifs2, fs2, others2) of
(_, [], [], [], [], []) =>