Mercurial > urweb
comparison 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 |
comparison
equal
deleted
inserted
replaced
1625:bd34a4af516a | 1626:07eed8386f07 |
---|---|
533 others : L'.con list | 533 others : L'.con list |
534 } | 534 } |
535 | 535 |
536 fun summaryToCon {fields, unifs, others} = | 536 fun summaryToCon {fields, unifs, others} = |
537 let | 537 let |
538 fun concat (c1, c2) = | |
539 case #1 c1 of | |
540 L'.CRecord (_, []) => c2 | |
541 | _ => case #1 c2 of | |
542 L'.CRecord (_, []) => c1 | |
543 | _ => (L'.CConcat (c1, c2), dummy) | |
544 | |
538 val c = (L'.CRecord (ktype, []), dummy) | 545 val c = (L'.CRecord (ktype, []), dummy) |
539 val c = List.foldr (fn (c', c) => (L'.CConcat (c', c), dummy)) c others | 546 val c = List.foldr concat c others |
540 val c = List.foldr (fn ((c', _), c) => (L'.CConcat (c', c), dummy)) c unifs | 547 val c = List.foldr (fn ((c', _), c) => concat (c', c)) c unifs |
541 in | 548 in |
542 (L'.CConcat ((L'.CRecord (ktype, fields), dummy), c), dummy) | 549 concat ((L'.CRecord (ktype, fields), dummy), c) |
543 end | 550 end |
544 | 551 |
545 fun p_summary env s = p_con env (summaryToCon s) | 552 fun p_summary env s = p_con env (summaryToCon s) |
546 | 553 |
547 exception CUnify of L'.con * L'.con * cunify_error | 554 exception CUnify of L'.con * L'.con * cunify_error |
900 | _ => (fs1, fs2, others1, others2, unifs1, unifs2) | 907 | _ => (fs1, fs2, others1, others2, unifs1, unifs2) |
901 | 908 |
902 val () = if !mayDelay then | 909 val () = if !mayDelay then |
903 () | 910 () |
904 else | 911 else |
905 reducedSummaries := SOME (p_summary env {fields = fs1, unifs = unifs1, others = others1}, | 912 let |
906 p_summary env {fields = fs2, unifs = unifs2, others = others2}) | 913 val c1 = summaryToCon {fields = fs1, unifs = unifs1, others = others1} |
914 val c2 = summaryToCon {fields = fs2, unifs = unifs2, others = others2} | |
915 in | |
916 case (c1, c2) of | |
917 ((L'.CRecord (_, []), _), (L'.CRecord (_, []), _)) => reducedSummaries := NONE | |
918 | _ => reducedSummaries := SOME (p_con env c1, p_con env c2) | |
919 end | |
907 | 920 |
908 (*val () = eprefaces "Summaries5" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}), | 921 (*val () = eprefaces "Summaries5" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}), |
909 ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*) | 922 ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*) |
910 | 923 |
911 val empty = (L'.CRecord (k, []), loc) | 924 val empty = (L'.CRecord (k, []), loc) |