Mercurial > urweb
comparison src/elaborate.sml @ 1588:65d6488c82d5
Fix confusing error message when record unification fails because enclosed types are incompatible
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Sat, 05 Nov 2011 09:56:52 -0400 |
parents | 03ad79980b55 |
children | fb0388f1180e |
comparison
equal
deleted
inserted
replaced
1587:257421857680 | 1588:65d6488c82d5 |
---|---|
917 NONE => findPointwise fs1 | 917 NONE => findPointwise fs1 |
918 | SOME (_, c2) => | 918 | SOME (_, c2) => |
919 if consEq env loc (c1, c2) then | 919 if consEq env loc (c1, c2) then |
920 findPointwise fs1 | 920 findPointwise fs1 |
921 else | 921 else |
922 SOME (nm1, c1, c2, (unifyCons env loc c1 c2; NONE) handle CUnify (_, _, err) => SOME err) | 922 SOME (nm1, c1, c2, (unifyCons env loc c1 c2; NONE) |
923 handle CUnify (_, _, err) => (reducedSummaries := NONE; | |
924 SOME err)) | |
923 in | 925 in |
924 raise CUnify' (CRecordFailure (unsummarize s1, unsummarize s2, findPointwise (#fields s1))) | 926 raise CUnify' (CRecordFailure (unsummarize s1, unsummarize s2, findPointwise (#fields s1))) |
925 end | 927 end |
926 | 928 |
927 fun default () = if !mayDelay then | 929 fun default () = if !mayDelay then |
937 | (_, _, _, [], [], [cr as (L'.CUnif (nl, _, _, _, r), _)]) => | 939 | (_, _, _, [], [], [cr as (L'.CUnif (nl, _, _, _, r), _)]) => |
938 let | 940 let |
939 val c = summaryToCon {fields = fs1, unifs = unifs1, others = others1} | 941 val c = summaryToCon {fields = fs1, unifs = unifs1, others = others1} |
940 in | 942 in |
941 if occursCon r c then | 943 if occursCon r c then |
942 raise CUnify' (COccursCheckFailed (cr, c)) | 944 (reducedSummaries := NONE; |
945 raise CUnify' (COccursCheckFailed (cr, c))) | |
943 else | 946 else |
944 (r := SOME (squish nl c)) | 947 (r := SOME (squish nl c)) |
945 handle CantSquish => default () | 948 handle CantSquish => default () |
946 end | 949 end |
947 | ([], [], [cr as (L'.CUnif (nl, _, _, _, r), _)], _, _, _) => | 950 | ([], [], [cr as (L'.CUnif (nl, _, _, _, r), _)], _, _, _) => |
948 let | 951 let |
949 val c = summaryToCon {fields = fs2, unifs = unifs2, others = others2} | 952 val c = summaryToCon {fields = fs2, unifs = unifs2, others = others2} |
950 in | 953 in |
951 if occursCon r c then | 954 if occursCon r c then |
952 raise CUnify' (COccursCheckFailed (cr, c)) | 955 (reducedSummaries := NONE; |
956 raise CUnify' (COccursCheckFailed (cr, c))) | |
953 else | 957 else |
954 (r := SOME (squish nl c)) | 958 (r := SOME (squish nl c)) |
955 handle CantSquish => default () | 959 handle CantSquish => default () |
956 end | 960 end |
957 | _ => default ()) | 961 | _ => default ()) |