summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2012-01-05 19:13:31 -0500
committerGravatar Adam Chlipala <adam@chlipala.net>2012-01-05 19:13:31 -0500
commita86d650aac1d3dca4444bd265dca563d1ed9e8e8 (patch)
tree7f2d0da996026263155315773cf414e05cef8717 /src
parentbdf80c57c95d50feee39ba0999835ad545b6cfde (diff)
Tweak new unification heuristic
Diffstat (limited to 'src')
-rw-r--r--src/elaborate.sml11
1 files changed, 7 insertions, 4 deletions
diff --git a/src/elaborate.sml b/src/elaborate.sml
index 89c077e5..6556a8d6 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -865,12 +865,15 @@
val (unifs1, unifs2) = eatMatching (fn ((_, r1), (_, r2)) => r1 = r2) (#unifs s1, #unifs s2)
- val hasUnifs = U.Con.exists {kind = fn _ => false,
- con = fn L'.CUnif _ => true
- | _ => false}
+ fun isMappy (c, _) =
+ case c of
+ L'.CApp ((L'.CMap _, _), c) => isMappy c
+ | L'.CUnif _ => true
+ | _ => false
val (others1, others2) = eatMatching (fn (c1, c2) =>
- not (hasUnifs c1 andalso hasUnifs c2)
+ not (isMappy c1 andalso isMappy c2)
+ (* I guess this is a pretty bad hack, based on one pattern of bad unification I've seen! *)
andalso consEq env loc (c1, c2)) (#others s1, #others s2)
(*val () = eprefaces "Summaries3" [("#1", p_summary env {fields = fs1, unifs = unifs1, others = others1}),
("#2", p_summary env {fields = fs2, unifs = unifs2, others = others2})]*)