Improve rule description
[sat-britney.git] / ArchMap.hs
1 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
2
3 module ArchMap where
4
5 import Control.Arrow
6 import Data.Functor
7 import Control.DeepSeq
8
9 import qualified Data.IntMap as M
10 import Arches
11
12 import qualified GHC.Exts ( build )
13
14 -- instance NFData a => NFData (M.IntMap a) where rnf m = rnf (M.toList m)
15
16 newtype Map b = ArchMap { unArchMap :: M.IntMap b }
17   deriving (NFData, Show)
18
19 empty :: Map a
20 empty = ArchMap M.empty
21
22 (!) :: Map a -> Arch -> a
23 (ArchMap m) ! (Arch i) = m M.! i
24
25 lookup :: Arch-> Map a -> Maybe a
26 lookup (Arch i) (ArchMap m) = M.lookup i m
27
28 notMember :: Arch -> Map a -> Bool
29 Arch x `notMember` ArchMap s = x `M.notMember` s
30
31 member :: Arch -> Map a -> Bool
32 Arch x `member` ArchMap s = x `M.member` s
33
34
35 findWithDefault :: a -> Arch -> Map a -> a
36 findWithDefault d (Arch i) (ArchMap m) = M.findWithDefault d i m
37
38 union :: Map b -> Map b -> Map b
39 ArchMap m1 `union` ArchMap m2 = ArchMap (m1 `M.union` m2)
40
41 unions :: [Map b] -> Map b
42 unions = ArchMap . M.unions . Prelude.map unArchMap
43
44 unionsWith ::  (b -> b -> b) -> [Map b] -> Map b
45 unionsWith f = ArchMap . M.unionsWith f . Prelude.map unArchMap
46
47 size :: Map a -> Int
48 size (ArchMap m) = M.size m
49
50 difference :: Map b -> Map b1 -> Map b
51 ArchMap m1 `difference` ArchMap m2 = ArchMap (m1 `M.difference` m2)
52
53 unionWith :: (b -> b -> b) -> Map b -> Map b -> Map b
54 unionWith f (ArchMap m1) (ArchMap m2) = ArchMap (M.unionWith f m1 m2)
55
56 keys :: Map a1 -> [Arch]
57 keys (ArchMap m1) = Arch <$> M.keys m1
58
59 elems :: Map a1 -> [a1]
60 elems (ArchMap m1) = M.elems m1
61
62 toList :: Map d -> [(Arch, d)]
63 toList (ArchMap m1) = first Arch <$> M.toList m1
64
65 {-# RULES "ArchMap/toList" forall m . toList m = GHC.Exts.build (\c n -> foldWithKey (\k x xs -> c (k,x) xs) n m) #-}
66
67 fromListWith :: (b -> b -> b) -> [(Arch, b)] -> Map b
68 fromListWith f l = ArchMap $ M.fromListWith f (first unArch <$> l)
69
70 fromList :: [(Arch, b)] -> Map b
71 fromList l = ArchMap $ M.fromList (first unArch <$> l)
72
73 fromAscList :: [(Arch, b)] -> Map b
74 fromAscList l = ArchMap $ M.fromAscList (first unArch <$> l)
75
76 fromDistinctAscList :: [(Arch, b)] -> Map b
77 fromDistinctAscList l = ArchMap $ M.fromDistinctAscList (first unArch <$> l)
78
79 filterWithKey :: (Arch -> b -> Bool) -> Map b -> Map b
80 filterWithKey f (ArchMap m) = ArchMap $ M.filterWithKey (\k v -> f (Arch k) v) m
81
82 insertWith :: (b -> b -> b) -> Arch -> b -> Map b -> Map b
83 insertWith f (Arch k) v (ArchMap m) = ArchMap $ M.insertWith f k v m
84
85 filter :: (b -> Bool) -> Map b -> Map b
86 filter f (ArchMap m) = ArchMap $ M.filter f m
87
88 map :: (a1 -> b) -> Map a1 -> Map b
89 map f (ArchMap m) = ArchMap $ M.map f m
90
91 mapWithKey :: (Arch -> a1 -> b) -> Map a1 -> Map b
92 mapWithKey f (ArchMap m) = ArchMap $ M.mapWithKey (\i v -> f (Arch i) v) m
93
94 mapMaybeWithKey :: (Arch -> a1 -> Maybe b) -> Map a1 -> Map b
95 mapMaybeWithKey f (ArchMap m) = ArchMap $ M.mapMaybeWithKey (\i v -> f (Arch i) v) m
96
97 foldWithKey :: (Arch -> a -> b -> b) -> b -> Map a -> b
98 foldWithKey f x (ArchMap m) = M.foldWithKey (\i v x' -> f (Arch i) v x') x m
99
100 fold :: (a -> b -> b) -> b -> Map a -> b
101 fold f x (ArchMap m) = M.fold f x m
102
103 build :: [Arch] -> (Arch -> b) -> Map b
104 build as f = fromList [ (a, f a) | a <- as ]
105
106 buildM :: [Arch] -> (Arch -> IO b) -> IO (Map b)
107 buildM as f = fromList <$> sequence [ do { x <- f a ; return (a , x) } | a <- as ]