diff options
| author |  Adam Chlipala <adam@chlipala.net> | 2011-12-03 16:39:45 -0500 |
|---|---|---|
| committer | Adam Chlipala <adam@chlipala.net> | 2011-12-03 16:39:45 -0500 |
| commit | d5716bee3e75662a36a081947c0f06dcd774c563 (patch) | |
| tree | 3fd6c8de1bc9008cd4267202f106d19a289305b9 | |
| parent | 5ee15d277b88084242dc2950f6c85e252d13f1b4 (diff) | |
Nicer record summary error messages
| -rw-r--r-- | src/elaborate.sml | 23 |
1 files changed, 18 insertions, 5 deletions
diff --git a/src/elaborate.sml b/src/elaborate.sml index fd6ce8ce..a1da9feb 100644 --- a/src/elaborate.sml +++ b/src/elaborate.sml @@ -535,11 +535,18 @@ fun summaryToCon {fields, unifs, others} = let + fun concat (c1, c2) = + case #1 c1 of + L'.CRecord (_, []) => c2 + | _ => case #1 c2 of + L'.CRecord (_, []) => c1 + | _ => (L'.CConcat (c1, c2), dummy) + val c = (L'.CRecord (ktype, []), dummy) - val c = List.foldr (fn (c', c) => (L'.CConcat (c', c), dummy)) c others - val c = List.foldr (fn ((c', _), c) => (L'.CConcat (c', c), dummy)) c unifs + val c = List.foldr concat c others + val c = List.foldr (fn ((c', _), c) => concat (c', c)) c unifs in - (L'.CConcat ((L'.CRecord (ktype, fields), dummy), c), dummy) + concat ((L'.CRecord (ktype, fields), dummy), c) end fun p_summary env s = p_con env (summaryToCon s) @@ -902,8 +909,14 @@ val () = if !mayDelay then () else - reducedSummaries := SOME (p_summary env {fields = fs1, unifs = unifs1, others = others1}, - p_summary env {fields = fs2, unifs = unifs2, others = others2}) + let + val c1 = summaryToCon {fields = fs1, unifs = unifs1, others = others1} + val c2 = summaryToCon {fields = fs2, unifs = unifs2, others = others2} + in + case (c1, c2) of + ((L'.CRecord (_, []), _), (L'.CRecord (_, []), _)) => reducedSummaries := NONE + | _ => reducedSummaries := SOME (p_con env c1, p_con env c2) + end (*val () = eprefaces "Summaries5" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}), ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*) |