X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Futils%2FUniqFM.lhs;h=19b1428d90bfe812f81428e36c067d36cf0d939c;hb=e95ee1f718c6915c478005aad8af81705357d6ab;hp=293e48ed14911410a0a96e2f34d656e35a43bb85;hpb=5ff8ce7ff0d45ce13937ad2c24a2e37ffdd2337f;p=ghc-hetmet.git 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