From: Ian Lynagh <igloo@earth.li>
Date: Tue, 4 May 2010 18:03:02 +0000 (+0000)
Subject: Fix build with GHC 6.10
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=63dde2e3cb89839f7375363bde31fabdcddb1462

Fix build with GHC 6.10
In GHC 6.10, intersectionWith is (a -> b -> a) instead of (a -> b -> c),
so we need to jump through some hoops to get the more general type.
---

diff --git a/compiler/utils/UniqFM.lhs b/compiler/utils/UniqFM.lhs
index 293e48e..19b1428 100644
--- a/compiler/utils/UniqFM.lhs
+++ b/compiler/utils/UniqFM.lhs
@@ -183,7 +183,20 @@ plusUFM (UFM x) (UFM y) = UFM (M.union y x)
 plusUFM_C f (UFM x) (UFM y) = UFM (M.unionWith f x y)
 minusUFM (UFM x) (UFM y) = UFM (M.difference x y)
 intersectUFM (UFM x) (UFM y) = UFM (M.intersection x y)
+#if __GLASGOW_HASKELL__ >= 611
 intersectUFM_C f (UFM x) (UFM y) = UFM (M.intersectionWith f x y)
+#else
+-- In GHC 6.10, intersectionWith is (a -> b -> a) instead of (a -> b -> c),
+-- so we need to jump through some hoops to get the more general type.
+intersectUFM_C f (UFM x) (UFM y) = UFM z
+    where z = let x' = M.map Left x
+                  f' (Left a) b = Right (f a b)
+                  f' (Right _) _ = panic "intersectUFM_C: f': Right"
+                  z' = M.intersectionWith f' x' y
+                  fromRight (Right a) = a
+                  fromRight _ = panic "intersectUFM_C: Left"
+              in M.map fromRight z'
+#endif
 
 foldUFM k z (UFM m) = M.fold k z m
 foldUFM_Directly k z (UFM m) = M.foldWithKey (k . getUnique) z m