[start converting to new type family based SetMap
John Meacham <john@repetae.net>**20100724030615
 Ignore-this: 24f5723c4e4c0eda3527232c2d57d327
] hunk ./src/Info/Types.hs 25
-
hunk ./src/Info/Types.hs 27
-    deriving(Typeable,Eq,HasSize,Monoid,SetLike,BuildSet Property,ModifySet Property,IsEmpty)
-
+    deriving(Typeable,Eq,Collection,SetLike,HasSize,Monoid,Unionize,IsEmpty)
hunk ./src/Info/Types.hs 29
+type instance Elem Properties = Property
+type instance Key Properties = Property
hunk ./src/Util/BitSet.hs 20
-
hunk ./src/Util/BitSet.hs 24
+    
+instance Unionize BitSet where
+    BitSet a `difference` BitSet b = BitSet (a .&. complement b)
+    BitSet a `intersection` BitSet b = BitSet (a .&. b)
hunk ./src/Util/BitSet.hs 29
+type instance  Elem BitSet = Int
hunk ./src/Util/BitSet.hs 31
+instance Collection BitSet where 
+--    type Elem BitSet = Int
+    singleton i = BitSet (bit i)
+    fromList ts = BitSet (foldl' setBit 0 ts)
+    toList (BitSet w) = f w 0 where
+        f 0 _ = []
+        f w n = if even w then f (w `shiftR` 1) (n + 1) else n:f (w `shiftR` 1) (n + 1)
+
+type instance Key BitSet = Elem BitSet
+instance SetLike BitSet where
+    keys bs = toList bs
+    delete i (BitSet v) = BitSet (clearBit v i)
+    member i (BitSet v) = testBit v i
+    insert i (BitSet v) = BitSet (v .|. bit i)
+    sfilter fn (BitSet w) = f w 0 0 where
+        f 0 _ r = BitSet r
+        f w n r = if even w || not (fn n) then f w1 n1 r else f w1 n1 (setBit r n) where
+            !n1 = n + 1
+            !w1 = w `shiftR` 1
+    
hunk ./src/Util/BitSet.hs 60
+{-
hunk ./src/Util/BitSet.hs 89
+-}
hunk ./src/Util/BitSet.hs 94
+newtype EnumBitSet a = EBS BitSet
+    deriving(Monoid,Unionize,HasSize,Eq,Ord,IsEmpty)
hunk ./src/Util/BitSet.hs 97
-newtype EnumBitSet a = EnumBitSet BitSet
-    deriving(Monoid,SetLike,HasSize,Eq,Ord,IsEmpty)
+type instance Elem (EnumBitSet a) = a
+instance Enum a => Collection (EnumBitSet a) where 
+--    type Elem (EnumBitSet a) = a
+    singleton i = EBS $ singleton (fromEnum i)
+    fromList ts = EBS $ fromList (map fromEnum ts)
+    toList (EBS w) = map toEnum $ toList w
+
+type instance  Key (EnumBitSet a) = Elem (EnumBitSet a)
+instance Enum a => SetLike (EnumBitSet a) where
+    delete (fromEnum -> i) (EBS v) = EBS $ delete i v
+    member (fromEnum -> i) (EBS v) = member i v
+    insert (fromEnum -> i) (EBS v) = EBS $ insert i v
+    sfilter f (EBS v) = EBS $ sfilter (f . toEnum) v
+    
hunk ./src/Util/BitSet.hs 112
+{-
hunk ./src/Util/BitSet.hs 128
+-}
hunk ./src/Util/SetLike.hs 1
-module Util.SetLike(
-    EnumSet(),
-    (\\),
-    notMember,
-    mnotMember,
-    minsert,
-    msingleton,
-    intersects,
-    mfindWithDefault,
-    SetLike(..),
-    ModifySet(..),
-    MapLike(..),
-    BuildSet(..)
-    ) where
-
+module Util.SetLike where
hunk ./src/Util/SetLike.hs 4
-import Data.Typeable
-import qualified Data.IntMap as IM
-import qualified Data.IntSet as IS
hunk ./src/Util/SetLike.hs 5
+import qualified Data.IntMap as IM
hunk ./src/Util/SetLike.hs 7
-
-import Util.HasSize
-
-infixl 9 \\ --
-
-(\\) :: SetLike s => s -> s -> s
-m1 \\ m2 = difference m1 m2
-
-class (HasSize s,IsEmpty s) => SetLike s where
-    difference :: s -> s -> s
-    intersection :: s -> s -> s
-    disjoint :: s -> s -> Bool
-    isSubsetOf :: s -> s -> Bool
+import qualified Data.IntSet as IS
hunk ./src/Util/SetLike.hs 9
+class Monoid s => Unionize s where
hunk ./src/Util/SetLike.hs 12
-    sempty :: s
-
-    disjoint x y = isEmpty (x `intersection` y)
-    isSubsetOf x y = size x <= size y && (size (x `intersection` y) == size x)
-    unions ss = foldr union sempty ss
-
-
--- you can't pull values out of the set with this, as it might store the
--- essence of a data type
-
-class SetLike s => BuildSet t s | s -> t where
-    fromList :: [t] -> s
-    fromDistinctAscList :: [t] -> s
-    insert :: t -> s -> s
-    singleton :: t -> s
+    difference :: s -> s -> s
+    intersection :: s -> s -> s
+    unions = mconcat
+    union = mappend
hunk ./src/Util/SetLike.hs 17
-    singleton t = fromDistinctAscList [t]
-    fromDistinctAscList = fromList
+type family Elem es
+type family Key s :: *
+type family Value m :: *
+
+class Monoid s => Collection s where
+    fromList :: [Elem s] -> s
+    toList :: s -> [Elem s]
+    singleton :: Elem s -> s
+    singleton e = fromList [e]
hunk ./src/Util/SetLike.hs 27
-class BuildSet t s => ModifySet t s | s -> t where
-    toList :: s -> [t]
-    delete :: t -> s -> s
-    member :: t -> s -> Bool
-    sfilter :: (t -> Bool) -> s -> s
+type instance Elem [e] = e
hunk ./src/Util/SetLike.hs 29
-notMember :: (ModifySet t s) => t -> s -> Bool
-notMember x t = not $ member x t
-mnotMember :: (MapLike k v m) => k -> m -> Bool
-mnotMember x t = not $ mmember x t
+instance Collection [e] where
+    fromList = id
+    toList = id
hunk ./src/Util/SetLike.hs 33
-intersects :: (SetLike s) => s -> s -> Bool
-intersects x y = not $ disjoint x y
+
+class Collection s => SetLike s where
+    keys :: s -> [Key s]
+    member :: Key s -> s -> Bool
+    delete :: Key s -> s -> s
+    sfilter :: (Elem s -> Bool) -> s -> s
+    insert :: Elem s -> s -> s
hunk ./src/Util/SetLike.hs 42
---  int set
+class SetLike m => MapLike m where
+    mlookup :: Key m -> m -> Maybe (Value m)
+    values :: m -> [Value m]
hunk ./src/Util/SetLike.hs 46
-instance SetLike IS.IntSet where
+instance Unionize IS.IntSet where
+    union = IS.union
hunk ./src/Util/SetLike.hs 50
-    isSubsetOf = IS.isSubsetOf
-    union      = IS.union
-    unions     = IS.unions
-    sempty      = IS.empty
hunk ./src/Util/SetLike.hs 51
-instance BuildSet Int IS.IntSet where
-    fromList xs = IS.fromList xs
-    fromDistinctAscList xs = IS.fromDistinctAscList xs
-    insert x s = IS.insert x s
-    singleton x = IS.singleton x
+type instance Elem IS.IntSet = Int
+
+instance Collection IS.IntSet where
+    fromList = IS.fromList
+    toList = IS.toList
+    singleton = IS.singleton
hunk ./src/Util/SetLike.hs 58
-instance ModifySet Int IS.IntSet where
-    toList s   = IS.toList s
-    delete x s = IS.delete x s
-    member x s = IS.member x s
-    sfilter    = IS.filter
-
--- normal set
+type instance  Key IS.IntSet = Int
+instance SetLike IS.IntSet where
+    keys = IS.toList
+    member = IS.member
+    sfilter = IS.filter
+    delete = IS.delete
+    insert = IS.insert
hunk ./src/Util/SetLike.hs 66
-instance Ord a => SetLike (S.Set a) where
-    difference = S.difference
+instance Ord k => Unionize (S.Set k) where
+    union = S.union
hunk ./src/Util/SetLike.hs 69
-    isSubsetOf = S.isSubsetOf
-    union      = S.union
-    unions     = S.unions
-    sempty      = S.empty
-
-instance Ord a => BuildSet a (S.Set a) where
-    fromList xs = S.fromList xs
-    fromDistinctAscList xs = S.fromDistinctAscList xs
-    insert x s = S.insert x s
-    singleton x = S.singleton x
+    difference = S.difference
hunk ./src/Util/SetLike.hs 71
-instance Ord a => ModifySet a (S.Set a) where
-    toList s   = S.toList s
-    member x s = S.member x s
-    delete x s = S.delete x s
-    sfilter    = S.filter
+type instance  Elem (S.Set k) = k
+instance Ord k => Collection (S.Set k) where
+    fromList = S.fromList
+    toList = S.toList
+    singleton = S.singleton
hunk ./src/Util/SetLike.hs 77
--- maps
+type instance Key (S.Set k) = k
+instance Ord k => SetLike (S.Set k) where
+    keys = S.toList
+    member = S.member
+    sfilter = S.filter
+    delete = S.delete
+    insert = S.insert
hunk ./src/Util/SetLike.hs 85
-instance SetLike (IM.IntMap a) where    -- SIC
+instance Unionize (IM.IntMap v) where
+    union = IM.union
hunk ./src/Util/SetLike.hs 89
-    union      = IM.union
-    unions     = IM.unions
-    sempty     = IM.empty
-
hunk ./src/Util/SetLike.hs 90
-instance BuildSet (Int,a) (IM.IntMap a) where
-    fromList xs = IM.fromList xs
-    fromDistinctAscList xs = IM.fromDistinctAscList xs
-    insert (k,v) s = IM.insert k v s
+type instance Elem (IM.IntMap v) = (Int,v)
+instance Collection (IM.IntMap v) where
+    fromList = IM.fromList
+    toList = IM.toList
hunk ./src/Util/SetLike.hs 96
+type instance Key (IM.IntMap v) = Int
+instance SetLike (IM.IntMap v) where
+    keys = IM.keys
+    member = IM.member
+    sfilter f = IM.filterWithKey (\ k v -> f (k,v))
+    delete = IM.delete
+    insert (k,v) = IM.insert k v
hunk ./src/Util/SetLike.hs 104
-instance Ord a => SetLike (M.Map a b) where
+type instance Value (IM.IntMap v) = v
+instance MapLike (IM.IntMap v) where
+    mlookup = IM.lookup
+    values = IM.elems
+
+instance Ord k => Unionize (M.Map k v) where
+    union = M.union
hunk ./src/Util/SetLike.hs 113
-    union      = M.union
-    unions     = M.unions
-    sempty     = M.empty
hunk ./src/Util/SetLike.hs 114
-instance Ord a => BuildSet (a,b) (M.Map a b) where
-    fromList xs = M.fromList xs
-    fromDistinctAscList xs = M.fromDistinctAscList xs
-    insert (k,v) s = M.insert k v s
+type instance Elem (M.Map k v) = (k,v)
+instance Ord k => Collection (M.Map k v) where
+    fromList = M.fromList
+    toList = M.toList
hunk ./src/Util/SetLike.hs 120
-minsert :: BuildSet (k,v) s => k -> v -> s -> s
-minsert k v s = insert (k,v) s
+type instance Key (M.Map k v) = k
+instance Ord k => SetLike (M.Map k v) where
+    keys = M.keys
+    member = M.member
+    sfilter f = M.filterWithKey (\ k v -> f (k,v))
+    delete = M.delete
+    insert (k,v) = M.insert k v
+
+type instance Value (M.Map k v) = v
+instance Ord k => MapLike (M.Map k v) where
+    mlookup = M.lookup
+    values = M.elems
hunk ./src/Util/SetLike.hs 133
-msingleton :: BuildSet (k,v) s => k -> v -> s
-msingleton k v = singleton (k,v)
+minsert :: (MapLike m, Elem m ~ (k,v)) => k -> v -> m -> m
+minsert k v = insert (k,v)
hunk ./src/Util/SetLike.hs 136
+{-
+instance SetLike (GMap k v) where
+    type Elem (GMap k v) = (k,v)
+    type Key (GMap k v) = k
hunk ./src/Util/SetLike.hs 141
-class SetLike m => MapLike k v m | m -> k v where
-    mdelete :: k -> m -> m
-    mmember :: k -> m -> Bool
-    mlookup :: k -> m -> Maybe v
-    melems :: m -> [v]
-    massocs :: m -> [(k,v)]
-    mkeys :: m -> [k]
-    mmapWithKey :: (k -> v -> v) -> m -> m
-    mfilter :: (v -> Bool) -> m -> m
-    mfilterWithKey :: (k -> v -> Bool) -> m -> m
-    munionWith :: (v -> v -> v) -> m -> m -> m
-    mpartitionWithKey :: (k -> v -> Bool) -> m -> (m,m)
+instance SetLike (GSet k) where
+    type Elem (GSet k) = k
+    type Key (GSet k) = k
hunk ./src/Util/SetLike.hs 145
-    mkeys = map fst . massocs
-    melems = map snd . massocs
hunk ./src/Util/SetLike.hs 146
-instance MapLike Int a (IM.IntMap a) where
-    mdelete = IM.delete
-    mmember = IM.member
-    mlookup k m = IM.lookup k m
-    melems = IM.elems
-    mkeys = IM.keys
-    massocs = IM.toList
-    mfilter = IM.filter
-    mmapWithKey = IM.mapWithKey
-    mfilterWithKey = IM.filterWithKey
-    munionWith = IM.unionWith
-    mpartitionWithKey = IM.partitionWithKey
+class GMapKey k where
+    data GMap k :: * -> *
+    data GSet k :: *
+--    fromList :: [(k,v)] -> GMap k v
+--    fromDistinctAscList :: [(k,v)] -> GMap k v
+--    fromBinDistinctAscList :: Int -> [(k,v)] -> GMap k v
+--    insert :: k -> v -> GMap k v -> GMap k v
+--    union :: GMap k v -> GMap k v -> GMap k v
+--    toList :: GMap k v -> [(k,v)]
+--    delete :: k -> GMap k v -> GMap k v
+--    member :: k -> GMap k v -> Bool
+--    lookup :: k -> GMap k v -> Maybe v
hunk ./src/Util/SetLike.hs 159
-instance Ord k => MapLike k v (M.Map k v) where
-    mdelete = M.delete
-    mmember = M.member
-    mlookup k m = case M.lookup k m of
-        Nothing -> fail "Map: mlookup can't find key"
-        Just x -> return x
-    melems = M.elems
-    mkeys = M.keys
-    massocs = M.toList
-    mfilter = M.filter
-    mmapWithKey = M.mapWithKey
-    mfilterWithKey = M.filterWithKey
-    munionWith = M.unionWith
-    mpartitionWithKey = M.partitionWithKey
+--    fromDistinctAscList = fromList
+--    fromBinDistinctAscList _ = fromList
+--
+instance GMapKey Int where
+    newtype GMap Int v = GMapInt (IM.IntMap v)
+    fromList vs = GMapInt (IM.fromList vs)
+    toList (GMapInt x) = IM.toList x
+    insert k v (GMapInt m) = GMapInt (IM.insert k v m)
+    union (GMapInt x) (GMapInt y) = GMapInt $  x `IM.union` y
+    lookup k (GMapInt m) = IM.lookup k m
hunk ./src/Util/SetLike.hs 170
-mfindWithDefault :: MapLike k v m => v -> k -> m -> v
-mfindWithDefault d k m = case mlookup k m of
-    Nothing -> d
-    Just x -> x
+instance GMapKey a => GMapKey (Maybe a) where
+    data GMap (Maybe a) v = GMapMaybe (Maybe v) (GMap a v)
+-}
hunk ./src/Util/SetLike.hs 174
--- EnumSet
hunk ./src/Util/SetLike.hs 175
-newtype EnumSet a = EnumSet IS.IntSet
-    deriving(Typeable,Monoid,SetLike,HasSize,Eq,Ord,IsEmpty)
+{-
+class GMapKey k where
+    type GMap k :: * -> *
+    fromList :: [(k,v)] -> GMap k v
+    fromDistinctAscList :: [(k,v)] -> GMap k v
+    fromBinDistinctAscList :: Int -> [(k,v)] -> GMap k v
+    insert :: k -> v -> GMap k v -> GMap k v
+    union :: GMap k v -> GMap k v -> GMap k v
+    toList :: GMap k v -> [(k,v)]
+    delete :: k -> GMap k v -> GMap k v
+    member :: k -> GMap k v -> Bool
+    lookup :: k -> GMap k v -> Maybe v
+
+    fromDistinctAscList = fromList
+    fromBinDistinctAscList _ = fromList
+
+instance GMapKey Int where
+    type GMap Int v = (IM.IntMap v)
+    fromList vs = (IM.fromList vs)
+    toList x = IM.toList x
+    insert k v m = (IM.insert k v m)
+    union x y =  x `IM.union` y
+    lookup k m = IM.lookup k m
hunk ./src/Util/SetLike.hs 199
-instance Enum a => BuildSet a (EnumSet a) where
-    fromList xs = EnumSet $ IS.fromList (map fromEnum xs)
-    fromDistinctAscList xs = EnumSet $ IS.fromDistinctAscList (map fromEnum xs)
-    insert x (EnumSet s) = EnumSet $ IS.insert (fromEnum x) s
-    singleton x = EnumSet $ IS.singleton (fromEnum x)
hunk ./src/Util/SetLike.hs 200
-instance Enum a => ModifySet a (EnumSet a) where
-    toList (EnumSet s) = map toEnum $ toList s
-    member x (EnumSet s) = IS.member (fromEnum x) s
-    delete x (EnumSet s) = EnumSet $ IS.delete (fromEnum x) s
-    sfilter f (EnumSet s) = EnumSet $ IS.filter (f . toEnum)  s
+data GMapMaybe k v = GMapMaybe (Maybe v) GMap k v)
+instance GMapKey a => GMapKey (Maybe a) where
+    data GMap (Maybe a) v = GMapMaybe (Maybe v) (GMap a v)
hunk ./src/Util/SetLike.hs 205
+-}