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)