comparison src/elaborate.sml @ 1660:b46c93ce7be2

Revert last unification tweak
author Adam Chlipala <adam@chlipala.net>
date Fri, 06 Jan 2012 09:40:20 -0500
parents de0a34e28bfa
children edf86cef0dba
comparison
equal deleted inserted replaced
1659:8de2ea0a0701 1660:b46c93ce7be2
863 (*val () = eprefaces "Summaries2" [("#1", p_summary env {fields = fs1, unifs = #unifs s1, others = #others s1}), 863 (*val () = eprefaces "Summaries2" [("#1", p_summary env {fields = fs1, unifs = #unifs s1, others = #others s1}),
864 ("#2", p_summary env {fields = fs2, unifs = #unifs s2, others = #others s2})]*) 864 ("#2", p_summary env {fields = fs2, unifs = #unifs s2, others = #others s2})]*)
865 865
866 val (unifs1, unifs2) = eatMatching (fn ((_, r1), (_, r2)) => r1 = r2) (#unifs s1, #unifs s2) 866 val (unifs1, unifs2) = eatMatching (fn ((_, r1), (_, r2)) => r1 = r2) (#unifs s1, #unifs s2)
867 867
868 fun isMappy (c, _) = 868 val hasUnifs = U.Con.exists {kind = fn _ => false,
869 case c of 869 con = fn L'.CUnif _ => true
870 L'.CApp ((L'.CMap _, _), c) => isMappy c 870 | _ => false}
871 | L'.CUnif _ => true
872 | _ => false
873 871
874 val (others1, others2) = eatMatching (fn (c1, c2) => 872 val (others1, others2) = eatMatching (fn (c1, c2) =>
875 not (isMappy c1 andalso isMappy c2) 873 not (hasUnifs c1 andalso hasUnifs c2)
876 (* I guess this is a pretty bad hack, based on one pattern of bad unification I've seen! *)
877 andalso consEq env loc (c1, c2)) (#others s1, #others s2) 874 andalso consEq env loc (c1, c2)) (#others s1, #others s2)
878 (*val () = eprefaces "Summaries3" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}), 875 (*val () = eprefaces "Summaries3" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}),
879 ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*) 876 ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*)
880 877
881 fun unsummarize {fields, unifs, others} = 878 fun unsummarize {fields, unifs, others} =