Mercurial > urweb
diff src/elaborate.sml @ 1626:07eed8386f07
Nicer record summary error messages
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Sat, 03 Dec 2011 16:39:45 -0500 |
parents | 20f898c29525 |
children | 6c00d8af6239 |
line wrap: on
line diff
--- a/src/elaborate.sml Sat Dec 03 16:25:09 2011 -0500 +++ b/src/elaborate.sml Sat Dec 03 16:39:45 2011 -0500 @@ -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})]*)