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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
----------------------------------------------------------------------
-- |
-- Module : Assoc
-- Maintainer : Peter Ljunglöf
-- Stability : Stable
-- Portability : Haskell 98
--
-- > CVS $Date: 2005/04/12 10:49:45 $
-- > CVS $Author: peb $
-- > CVS $Revision: 1.3 $
--
-- Association lists, or finite maps,
-- including sets as maps with result type @()@.
-- function names stolen from module @Array@.
-- /O(log n)/ key lookup
-----------------------------------------------------------------------------
module GF.Data.Assoc ( Assoc,
Set,
emptyAssoc,
emptySet,
listAssoc,
listSet,
accumAssoc,
aAssocs,
aElems,
assocMap,
lookupAssoc,
lookupWith,
(?),
(?=)
) where
import GF.Data.SortedList
infixl 9 ?, ?=
-- | a set is a finite map with empty values
type Set a = Assoc a ()
emptyAssoc :: Ord a => Assoc a b
emptySet :: Ord a => Set a
-- | creating a finite map from a sorted key-value list
listAssoc :: Ord a => SList (a, b) -> Assoc a b
-- | creating a set from a sorted list
listSet :: Ord a => SList a -> Set a
-- | building a finite map from a list of keys and 'b's,
-- and a function that combines a sorted list of 'b's into a value
accumAssoc :: (Ord a, Ord c) => (SList c -> b) -> [(a, c)] -> Assoc a b
-- | all key-value pairs from an association list
aAssocs :: Ord a => Assoc a b -> SList (a, b)
-- | all keys from an association list
aElems :: Ord a => Assoc a b -> SList a
-- fmap :: Ord a => (b -> b') -> Assoc a b -> Assoc a b'
-- | mapping values to other values.
-- the mapping function can take the key as information
assocMap :: Ord a => (a -> b -> b') -> Assoc a b -> Assoc a b'
-- | monadic lookup function,
-- returning failure if the key does not exist
lookupAssoc :: (Ord a, Monad m) => Assoc a b -> a -> m b
-- | if the key does not exist,
-- the first argument is returned
lookupWith :: Ord a => b -> Assoc a b -> a -> b
-- | if the values are monadic, we can return the value type
(?) :: (Ord a, Monad m) => Assoc a (m b) -> a -> m b
-- | checking wheter the map contains a given key
(?=) :: Ord a => Assoc a b -> a -> Bool
------------------------------------------------------------
data Assoc a b = ANil | ANode (Assoc a b) a b (Assoc a b)
deriving (Eq, Ord, Show)
emptyAssoc = ANil
emptySet = emptyAssoc
listAssoc as = assoc
where (assoc, []) = sl2bst (length as) as
sl2bst 0 xs = (ANil, xs)
sl2bst 1 (x:xs) = (ANode ANil (fst x) (snd x) ANil, xs)
sl2bst n xs = (ANode left (fst x) (snd x) right, zs)
where llen = (n-1) `div` 2
rlen = n - 1 - llen
(left, x:ys) = sl2bst llen xs
(right, zs) = sl2bst rlen ys
listSet as = listAssoc (zip as (repeat ()))
accumAssoc join = listAssoc . map (mapSnd join) . groupPairs . nubsort
where mapSnd f (a, b) = (a, f b)
aAssocs as = prs as []
where prs ANil = id
prs (ANode left a b right) = prs left . ((a,b) :) . prs right
aElems = map fst . aAssocs
instance Ord a => Functor (Assoc a) where
fmap f = assocMap (const f)
assocMap f ANil = ANil
assocMap f (ANode left a b right) = ANode (assocMap f left) a (f a b) (assocMap f right)
lookupAssoc ANil _ = fail "key not found"
lookupAssoc (ANode left a b right) a' = case compare a a' of
GT -> lookupAssoc left a'
LT -> lookupAssoc right a'
EQ -> return b
lookupWith z ANil _ = z
lookupWith z (ANode left a b right) a' = case compare a a' of
GT -> lookupWith z left a'
LT -> lookupWith z right a'
EQ -> b
(?) = lookupWith (fail "key not found")
(?=) = \assoc -> maybe False (const True) . lookupAssoc assoc
|
