blob: f27961bb289d74433fcde6017d0239882b3267e4 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE TypeFamilies #-}
module Hoopl.Unique
( Unique
, UniqueMap
, UniqueSet
, intToUnique
) where
import qualified Data.IntMap as M
import qualified Data.IntSet as S
import Hoopl.Collections
-----------------------------------------------------------------------------
-- Unique
-----------------------------------------------------------------------------
type Unique = Int
intToUnique :: Int -> Unique
intToUnique = id
-----------------------------------------------------------------------------
-- UniqueSet
newtype UniqueSet = US S.IntSet deriving (Eq, Ord, Show)
instance IsSet UniqueSet where
type ElemOf UniqueSet = Unique
setNull (US s) = S.null s
setSize (US s) = S.size s
setMember k (US s) = S.member k s
setEmpty = US S.empty
setSingleton k = US (S.singleton k)
setInsert k (US s) = US (S.insert k s)
setDelete k (US s) = US (S.delete k s)
setUnion (US x) (US y) = US (S.union x y)
setDifference (US x) (US y) = US (S.difference x y)
setIntersection (US x) (US y) = US (S.intersection x y)
setIsSubsetOf (US x) (US y) = S.isSubsetOf x y
setFold k z (US s) = S.foldr k z s
setElems (US s) = S.elems s
setFromList ks = US (S.fromList ks)
-----------------------------------------------------------------------------
-- UniqueMap
newtype UniqueMap v = UM (M.IntMap v)
deriving (Eq, Ord, Show, Functor, Foldable, Traversable)
instance IsMap UniqueMap where
type KeyOf UniqueMap = Unique
mapNull (UM m) = M.null m
mapSize (UM m) = M.size m
mapMember k (UM m) = M.member k m
mapLookup k (UM m) = M.lookup k m
mapFindWithDefault def k (UM m) = M.findWithDefault def k m
mapEmpty = UM M.empty
mapSingleton k v = UM (M.singleton k v)
mapInsert k v (UM m) = UM (M.insert k v m)
mapInsertWith f k v (UM m) = UM (M.insertWith f k v m)
mapDelete k (UM m) = UM (M.delete k m)
mapUnion (UM x) (UM y) = UM (M.union x y)
mapUnionWithKey f (UM x) (UM y) = UM (M.unionWithKey (f . intToUnique) x y)
mapDifference (UM x) (UM y) = UM (M.difference x y)
mapIntersection (UM x) (UM y) = UM (M.intersection x y)
mapIsSubmapOf (UM x) (UM y) = M.isSubmapOf x y
mapMap f (UM m) = UM (M.map f m)
mapMapWithKey f (UM m) = UM (M.mapWithKey (f . intToUnique) m)
mapFold k z (UM m) = M.foldr k z m
mapFoldWithKey k z (UM m) = M.foldrWithKey (k . intToUnique) z m
mapFilter f (UM m) = UM (M.filter f m)
mapElems (UM m) = M.elems m
mapKeys (UM m) = M.keys m
mapToList (UM m) = M.toList m
mapFromList assocs = UM (M.fromList assocs)
mapFromListWith f assocs = UM (M.fromListWith f assocs)
|
