Mercurial > urweb
comparison src/elaborate.sml @ 1071:26197c957ad6
Better record summary error messages; more tweaking SQL usability
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 13 Dec 2009 11:28:47 -0500 |
parents | 38411c2cd363 |
children | b2311dfb3158 |
comparison
equal
deleted
inserted
replaced
1070:e933297c4e24 | 1071:26197c957ad6 |
---|---|
815 | 815 |
816 (*val () = eprefaces "Summaries5" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}), | 816 (*val () = eprefaces "Summaries5" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}), |
817 ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*) | 817 ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*) |
818 | 818 |
819 val empty = (L'.CRecord (k, []), loc) | 819 val empty = (L'.CRecord (k, []), loc) |
820 fun failure () = raise CUnify' (CRecordFailure (unsummarize s1, unsummarize s2)) | 820 fun failure () = |
821 let | |
822 val fs2 = #fields s2 | |
823 | |
824 fun findPointwise fs1 = | |
825 case fs1 of | |
826 [] => NONE | |
827 | (nm1, c1) :: fs1 => | |
828 case List.find (fn (nm2, _) => consEq env loc (nm1, nm2)) fs2 of | |
829 NONE => findPointwise fs1 | |
830 | SOME (_, c2) => | |
831 if consEq env loc (c1, c2) then | |
832 findPointwise fs1 | |
833 else | |
834 SOME (nm1, c1, c2) | |
835 in | |
836 raise CUnify' (CRecordFailure (unsummarize s1, unsummarize s2, findPointwise (#fields s1))) | |
837 end | |
821 in | 838 in |
822 (case (unifs1, fs1, others1, unifs2, fs2, others2) of | 839 (case (unifs1, fs1, others1, unifs2, fs2, others2) of |
823 (_, [], [], [], [], []) => | 840 (_, [], [], [], [], []) => |
824 app (fn (_, r) => r := SOME empty) unifs1 | 841 app (fn (_, r) => r := SOME empty) unifs1 |
825 | ([], [], [], _, [], []) => | 842 | ([], [], [], _, [], []) => |