never executed always true always false
1 {-# LANGUAGE DeriveTraversable #-}
2 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
3 {-# LANGUAGE TypeFamilies #-}
4
5 module GHC.Cmm.Dataflow.Collections
6 ( IsSet(..)
7 , setInsertList, setDeleteList, setUnions
8 , IsMap(..)
9 , mapInsertList, mapDeleteList, mapUnions
10 , UniqueMap, UniqueSet
11 ) where
12
13 import GHC.Prelude
14
15 import qualified Data.IntMap.Strict as M
16 import qualified Data.IntSet as S
17
18 import Data.List (foldl1')
19
20 class IsSet set where
21 type ElemOf set
22
23 setNull :: set -> Bool
24 setSize :: set -> Int
25 setMember :: ElemOf set -> set -> Bool
26
27 setEmpty :: set
28 setSingleton :: ElemOf set -> set
29 setInsert :: ElemOf set -> set -> set
30 setDelete :: ElemOf set -> set -> set
31
32 setUnion :: set -> set -> set
33 setDifference :: set -> set -> set
34 setIntersection :: set -> set -> set
35 setIsSubsetOf :: set -> set -> Bool
36 setFilter :: (ElemOf set -> Bool) -> set -> set
37
38 setFoldl :: (b -> ElemOf set -> b) -> b -> set -> b
39 setFoldr :: (ElemOf set -> b -> b) -> b -> set -> b
40
41 setElems :: set -> [ElemOf set]
42 setFromList :: [ElemOf set] -> set
43
44 -- Helper functions for IsSet class
45 setInsertList :: IsSet set => [ElemOf set] -> set -> set
46 setInsertList keys set = foldl' (flip setInsert) set keys
47
48 setDeleteList :: IsSet set => [ElemOf set] -> set -> set
49 setDeleteList keys set = foldl' (flip setDelete) set keys
50
51 setUnions :: IsSet set => [set] -> set
52 setUnions [] = setEmpty
53 setUnions sets = foldl1' setUnion sets
54
55
56 class IsMap map where
57 type KeyOf map
58
59 mapNull :: map a -> Bool
60 mapSize :: map a -> Int
61 mapMember :: KeyOf map -> map a -> Bool
62 mapLookup :: KeyOf map -> map a -> Maybe a
63 mapFindWithDefault :: a -> KeyOf map -> map a -> a
64
65 mapEmpty :: map a
66 mapSingleton :: KeyOf map -> a -> map a
67 mapInsert :: KeyOf map -> a -> map a -> map a
68 mapInsertWith :: (a -> a -> a) -> KeyOf map -> a -> map a -> map a
69 mapDelete :: KeyOf map -> map a -> map a
70 mapAlter :: (Maybe a -> Maybe a) -> KeyOf map -> map a -> map a
71 mapAdjust :: (a -> a) -> KeyOf map -> map a -> map a
72
73 mapUnion :: map a -> map a -> map a
74 mapUnionWithKey :: (KeyOf map -> a -> a -> a) -> map a -> map a -> map a
75 mapDifference :: map a -> map a -> map a
76 mapIntersection :: map a -> map a -> map a
77 mapIsSubmapOf :: Eq a => map a -> map a -> Bool
78
79 mapMap :: (a -> b) -> map a -> map b
80 mapMapWithKey :: (KeyOf map -> a -> b) -> map a -> map b
81 mapFoldl :: (b -> a -> b) -> b -> map a -> b
82 mapFoldr :: (a -> b -> b) -> b -> map a -> b
83 mapFoldlWithKey :: (b -> KeyOf map -> a -> b) -> b -> map a -> b
84 mapFoldMapWithKey :: Monoid m => (KeyOf map -> a -> m) -> map a -> m
85 mapFilter :: (a -> Bool) -> map a -> map a
86 mapFilterWithKey :: (KeyOf map -> a -> Bool) -> map a -> map a
87
88
89 mapElems :: map a -> [a]
90 mapKeys :: map a -> [KeyOf map]
91 mapToList :: map a -> [(KeyOf map, a)]
92 mapFromList :: [(KeyOf map, a)] -> map a
93 mapFromListWith :: (a -> a -> a) -> [(KeyOf map,a)] -> map a
94
95 -- Helper functions for IsMap class
96 mapInsertList :: IsMap map => [(KeyOf map, a)] -> map a -> map a
97 mapInsertList assocs map = foldl' (flip (uncurry mapInsert)) map assocs
98
99 mapDeleteList :: IsMap map => [KeyOf map] -> map a -> map a
100 mapDeleteList keys map = foldl' (flip mapDelete) map keys
101
102 mapUnions :: IsMap map => [map a] -> map a
103 mapUnions [] = mapEmpty
104 mapUnions maps = foldl1' mapUnion maps
105
106 -----------------------------------------------------------------------------
107 -- Basic instances
108 -----------------------------------------------------------------------------
109
110 newtype UniqueSet = US S.IntSet deriving (Eq, Ord, Show, Semigroup, Monoid)
111
112 instance IsSet UniqueSet where
113 type ElemOf UniqueSet = Int
114
115 setNull (US s) = S.null s
116 setSize (US s) = S.size s
117 setMember k (US s) = S.member k s
118
119 setEmpty = US S.empty
120 setSingleton k = US (S.singleton k)
121 setInsert k (US s) = US (S.insert k s)
122 setDelete k (US s) = US (S.delete k s)
123
124 setUnion (US x) (US y) = US (S.union x y)
125 setDifference (US x) (US y) = US (S.difference x y)
126 setIntersection (US x) (US y) = US (S.intersection x y)
127 setIsSubsetOf (US x) (US y) = S.isSubsetOf x y
128 setFilter f (US s) = US (S.filter f s)
129
130 setFoldl k z (US s) = S.foldl' k z s
131 setFoldr k z (US s) = S.foldr k z s
132
133 setElems (US s) = S.elems s
134 setFromList ks = US (S.fromList ks)
135
136 newtype UniqueMap v = UM (M.IntMap v)
137 deriving (Eq, Ord, Show, Functor, Foldable, Traversable)
138
139 instance IsMap UniqueMap where
140 type KeyOf UniqueMap = Int
141
142 mapNull (UM m) = M.null m
143 mapSize (UM m) = M.size m
144 mapMember k (UM m) = M.member k m
145 mapLookup k (UM m) = M.lookup k m
146 mapFindWithDefault def k (UM m) = M.findWithDefault def k m
147
148 mapEmpty = UM M.empty
149 mapSingleton k v = UM (M.singleton k v)
150 mapInsert k v (UM m) = UM (M.insert k v m)
151 mapInsertWith f k v (UM m) = UM (M.insertWith f k v m)
152 mapDelete k (UM m) = UM (M.delete k m)
153 mapAlter f k (UM m) = UM (M.alter f k m)
154 mapAdjust f k (UM m) = UM (M.adjust f k m)
155
156 mapUnion (UM x) (UM y) = UM (M.union x y)
157 mapUnionWithKey f (UM x) (UM y) = UM (M.unionWithKey f x y)
158 mapDifference (UM x) (UM y) = UM (M.difference x y)
159 mapIntersection (UM x) (UM y) = UM (M.intersection x y)
160 mapIsSubmapOf (UM x) (UM y) = M.isSubmapOf x y
161
162 mapMap f (UM m) = UM (M.map f m)
163 mapMapWithKey f (UM m) = UM (M.mapWithKey f m)
164 mapFoldl k z (UM m) = M.foldl' k z m
165 mapFoldr k z (UM m) = M.foldr k z m
166 mapFoldlWithKey k z (UM m) = M.foldlWithKey' k z m
167 mapFoldMapWithKey f (UM m) = M.foldMapWithKey f m
168 {-# INLINEABLE mapFilter #-}
169 mapFilter f (UM m) = UM (M.filter f m)
170 {-# INLINEABLE mapFilterWithKey #-}
171 mapFilterWithKey f (UM m) = UM (M.filterWithKey f m)
172
173 mapElems (UM m) = M.elems m
174 mapKeys (UM m) = M.keys m
175 {-# INLINEABLE mapToList #-}
176 mapToList (UM m) = M.toList m
177 mapFromList assocs = UM (M.fromList assocs)
178 mapFromListWith f assocs = UM (M.fromListWith f assocs)