[create a better relation representation, speed up export chasing signifigantly
John Meacham <john@repetae.net>**20100806082622
 Ignore-this: 9f49871e33348bbfc4e8fd2ee9fa71b8
] hunk ./src/FrontEnd/Exports.hs 21
+import Util.SetLike as SL
hunk ./src/FrontEnd/Exports.hs 72
-    let lf m = maybe (fail $ "determineExports'.lf: " ++ show m) return $  Map.lookup m  $ dmodMap `mappend` Map.fromList [ (modInfoName x,Set.fromList [(toUnqualified x,x) | x <- modInfoExport x]) |  x  <- xs]
+    let lf m = maybe (fail $ "determineExports'.lf: " ++ show m) return $  Map.lookup m  $ dmodMap `mappend` Map.fromList [ (modInfoName x,fromList [(toUnqualified x,x) | x <- modInfoExport x]) |  x  <- xs]
hunk ./src/FrontEnd/Exports.hs 80
-    dmodMap = Map.fromList  [ ( x,Set.fromList [(toUnqualified n,n) | n <- xs]) |  (x,xs) <- doneMods ]
+    dmodMap = Map.fromList  [ ( x,fromList [(toUnqualified n,n) | n <- xs]) |  (x,xs) <- doneMods ]
hunk ./src/FrontEnd/Exports.hs 93
-        let f (HsEModuleContents m) = mapDomain g unqs `R.intersection` qs where
+        let f (HsEModuleContents m) = mapDomain g unqs `intersection` qs where
hunk ./src/FrontEnd/Exports.hs 97
-        return $ mapDomain toUnqualified (R.unions $ map f es)
+        return $ mapDomain toUnqualified (unions $ map f es)
hunk ./src/FrontEnd/Exports.hs 109
-                    return $ if isHiding then es Set.\\ listed else listed
+                    return $ if isHiding then es SL.\\ listed else listed
hunk ./src/FrontEnd/Exports.hs 112
-        ls = R.fromList $  concat [ [(toUnqualified z,z),(z,z)]| (z, _, _) <- modInfoDefs mi]
+        ls = fromList $  concat [ [(toUnqualified z,z),(z,z)]| (z, _, _) <- modInfoDefs mi]
hunk ./src/FrontEnd/Exports.hs 119
-    entSpec isHiding rel (HsEVar n) = restrictDomain (== toName Val n) rel
-    entSpec isHiding rel (HsEAbs n) = restrictDomain (`elem` [ toName x n | x <- ts]) rel  where
+    entSpec isHiding rel (HsEVar n) = restrictDomainS (toName Val n) rel
+    entSpec isHiding rel (HsEAbs n) = restrictDomainSet (Set.fromList [ toName x n | x <- ts]) rel  where
hunk ./src/FrontEnd/Exports.hs 122
-    entSpec isHiding rel (HsEThingWith n xs) = restrictDomain (\x -> x `elem` concat (ct:(map (cd) xs)))  rel where
+    entSpec isHiding rel (HsEThingWith n xs) = restrictDomainSet (fromList (concat (ct:(map cd xs)))) rel where
hunk ./src/FrontEnd/Exports.hs 125
-    entSpec isHiding rel (HsEThingAll n) = restrictDomain (`elem` ct ) rel `mappend` restrictRange (`elem` ss) rel where
+    entSpec isHiding rel (HsEThingAll n) = rdl `mappend` restrictRange (`elem` ss) rel where
hunk ./src/FrontEnd/Exports.hs 127
-        ss = concat $ concat [ maybeToList (Map.lookup x ownsMap) | x <- Set.toList $ range (restrictDomain (`elem` ct) rel)]
-        cd n =  [toName DataConstructor n, toName Val n, toName FieldLabel n ]
+        ss = concat $ concat [ maybeToList (Map.lookup x ownsMap) | x <- Set.toList $ range rdl ]
+        cd n =  [toName DataConstructor n, toName Val n, toName FieldLabel n ]               
+        rdl = (restrictDomain (`elem` ct) rel)
hunk ./src/FrontEnd/Exports.hs 132
-defsToRel xs = R.fromList $ map f xs where
+defsToRel xs = fromList $ map f xs where
hunk ./src/Ho/Library.hs 21
-import System.IO
hunk ./src/Ho/Library.hs 103
-    if not verbose then putStr $ showYAML (map (libName . snd) libs) else do
+    if not verbose then putStr $ showYAML (sort $ map (libName . snd) libs) else do
hunk ./src/Util/Relation.hs 4
-module Util.Relation(module Util.Relation, module Set) where
+module Util.Relation where
hunk ./src/Util/Relation.hs 6
+import Data.Monoid
hunk ./src/Util/Relation.hs 8
-import qualified Data.Set as Set (map)
+import Util.SetLike
+import qualified Data.Set as Set
+import qualified Data.Map as Map
hunk ./src/Util/Relation.hs 12
-type Rel a b = Set (a,b)
+newtype Rel a b = Rel (Map.Map a (Set b))
+    deriving(Eq)
+
+instance (Ord a,Ord b) => Monoid (Rel a b) where
+    mempty = Rel mempty
+    mappend (Rel r1) (Rel r2) = Rel $ Map.unionWith Set.union r1 r2
+
+instance (Ord a,Ord b) => Unionize (Rel a b) where
+    difference (Rel r1) (Rel r2) = Rel $ Map.differenceWith f r1 r2 where
+        f r1 r2 = if Set.null rs then Nothing else Just rs where
+            rs = Set.difference r1 r2
+    intersection (Rel r1) (Rel r2) = prune $ Map.intersectionWith Set.intersection r1 r2
+
+instance (Ord a,Ord b) => Collection (Rel a b) where
+    fromList xs = Rel $ Map.fromListWith Set.union [ (x,Set.singleton y) | (x,y) <- xs ]
+    toList (Rel r) = [ (x,y) | (x,ys) <- Map.toList r, y <- Set.toList ys]
+
+prune r = Rel $ Map.mapMaybe f r where
+    f s = if Set.null s then Nothing else Just s
+
+
+type instance Elem (Rel a b) = (a,b)
+type instance Key (Rel a b) = (a,b)
hunk ./src/Util/Relation.hs 38
-domain r = Set.map fst r
+domain (Rel r) = Map.keysSet r
hunk ./src/Util/Relation.hs 41
-range r = Set.map snd r
+range (Rel r) = Set.unions $ Map.elems r
hunk ./src/Util/Relation.hs 43
-flipRelation :: (Ord a, Ord b) => Rel a b -> Rel b a
-flipRelation = Set.map (\ (x,y) -> (y,x))
+--flipRelation :: (Ord a, Ord b) => Rel a b -> Rel b a
+--flipRelation (Rel r) = Rel $ Set.map (\ (x,y) -> (y,x)) r
hunk ./src/Util/Relation.hs 47
-restrictDomain f r = Set.filter (f . fst) r
+restrictDomain f (Rel r) = Rel $ Map.filterWithKey (\k _ -> f k) r
hunk ./src/Util/Relation.hs 49
-restrictRange :: (Ord a, Ord b) => (b -> Bool) -> Rel a b -> Rel a b
-restrictRange f r = Set.filter (f . snd) r
+restrictDomainS :: (Ord a, Ord b) => a -> Rel a b -> Rel a b
+restrictDomainS x (Rel r) = case Map.lookup x r of
+    Nothing -> Rel mempty
+    Just v -> Rel $ Map.singleton x v
hunk ./src/Util/Relation.hs 54
+restrictDomainSet :: (Ord a, Ord b) => Set a -> Rel a b -> Rel a b
+restrictDomainSet s (Rel r) = Rel $ Map.filterWithKey (\k _ -> k `Set.member` s) r
+
+restrictRange :: (Ord a, Ord b) => (b -> Bool) -> Rel a b -> Rel a b
+restrictRange f (Rel r) = Rel $ Map.mapMaybe g r where
+    g s = if Set.null ss then Nothing else Just ss where
+        ss = Set.filter f s
hunk ./src/Util/Relation.hs 63
-mapDomain f r = Set.map (\ (x,y) -> (f x,y)) r
+mapDomain f (Rel r) = Rel $ Map.mapKeys f r
hunk ./src/Util/Relation.hs 66
-mapRange f r = Set.map (\ (x,y) -> (x,f y)) r
+mapRange f (Rel r) = Rel $ Map.map (Set.map f) r
+
+partitionDomain f (Rel r) = case Map.partitionWithKey (\k _ -> f k) r of
+    (x,y) -> (Rel x,Rel y)
hunk ./src/Util/Relation.hs 71
-partitionDomain f r = Set.partition (f . fst) r
+--partitionRange f (Rel r) = Rel $ Set.partition (f . snd) r
hunk ./src/Util/Relation.hs 73
-partitionRange f r = Set.partition (f . snd) r
+--applyRelation :: (Ord a, Ord b) => Rel a b -> a -> [b]
+--applyRelation r a = Prelude.map snd (Set.toList . unRel $ restrictDomain (== a) r)
hunk ./src/Util/Relation.hs 76
-applyRelation :: (Ord a, Ord b) => Rel a b -> a -> [b]
-applyRelation r a = Prelude.map snd (toList $ restrictDomain (== a) r)
+unRel (Rel r) = r
hunk ./src/Util/Relation.hs 79
-toRelationList rel = [ (x, applyRelation rel x) | x <- toList (domain rel)]
+toRelationList (Rel r) = Map.toList (Map.map Set.toList r)
+--toRelationList :: (Ord a, Ord b) => Rel a b -> [(a,[b])]
+--toRelationList rel = [ (x, applyRelation rel x) | x <- Set.toList (domain rel)]