Mercurial > urweb
comparison src/elaborate.sml @ 1658:de0a34e28bfa
Tweak new unification heuristic
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Thu, 05 Jan 2012 19:13:31 -0500 |
parents | 2b7d3d99dc42 |
children | b46c93ce7be2 |
comparison
equal
deleted
inserted
replaced
1657:2b7d3d99dc42 | 1658:de0a34e28bfa |
---|---|
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 val hasUnifs = U.Con.exists {kind = fn _ => false, | 868 fun isMappy (c, _) = |
869 con = fn L'.CUnif _ => true | 869 case c of |
870 | _ => false} | 870 L'.CApp ((L'.CMap _, _), c) => isMappy c |
871 | L'.CUnif _ => true | |
872 | _ => false | |
871 | 873 |
872 val (others1, others2) = eatMatching (fn (c1, c2) => | 874 val (others1, others2) = eatMatching (fn (c1, c2) => |
873 not (hasUnifs c1 andalso hasUnifs c2) | 875 not (isMappy c1 andalso isMappy c2) |
876 (* I guess this is a pretty bad hack, based on one pattern of bad unification I've seen! *) | |
874 andalso consEq env loc (c1, c2)) (#others s1, #others s2) | 877 andalso consEq env loc (c1, c2)) (#others s1, #others s2) |
875 (*val () = eprefaces "Summaries3" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}), | 878 (*val () = eprefaces "Summaries3" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}), |
876 ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*) | 879 ("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*) |
877 | 880 |
878 fun unsummarize {fields, unifs, others} = | 881 fun unsummarize {fields, unifs, others} = |