65 import qualified Types.Data.List as L
66 import qualified Types.Data.List.Ops as L
68 import Types.Data.Bool
69 import Types.Data.List hiding (Null)
70 import Types.Data.List.Ops hiding (Map)
71 import Types.Data.Maybe
76 data Bin size key value left right
80 instance Map (Bin s k v l r)
84 type instance Null Tip = True
85 type instance Null (Bin s k v l r) = False
89 type instance Size Tip = D0
90 type instance Size (Bin s k v l r) = s
93 type CompCase a b ifLT ifGT ifEQ
94 = If (IsLT (Compare a b))
96 (If (IsGT (Compare a b))
101 type family Lookup k m
102 type instance Lookup k Tip = Nothing
103 type instance Lookup k (Bin s k' v l r)
110 type family LookupAssoc k m
111 type instance LookupAssoc k Tip = Nothing
112 type instance LookupAssoc k (Bin s k' v l r)
119 type Member k m = IsJust (Lookup k m)
122 type NotMember k m = Not (Member k m)
125 type Find k m = FromJust (Lookup k m)
128 type FindWithDefault a k m
129 = FromMaybe a (Lookup k m)
135 type Singleton k v = Bin D1 k v Tip Tip
138 type family Insert k v m
139 type instance Insert k v Tip = Singleton k v
140 type instance Insert k v (Bin s k' v' l r)
142 (Balance k' v' (Insert k v l) r)
143 (Balance k' v' l (Insert k v r))
147 type family Delete k m
148 type instance Delete k Tip = Tip
149 type instance Delete k (Bin s k' v l r)
151 (Balance k' v (Delete k l) r)
152 (Balance k' v l (Delete k r))
160 = If ((Size l :+: Size r) :<=: D1)
161 (Bin (Size l :+: Size r :+: D1) k v l r)
162 (If (Size r :>=: (Delta :*: Size l))
164 (If (Size l :>=: (Delta :*: Size r))
166 (Bin (Size l :+: Size r :+: D1) k v l r)))
169 type family RotateL k v l r
170 type instance RotateL k v l (Bin s k' v' l' r')
171 = If (Size l' :<: (Ratio :*: Size r'))
172 (SingleL k v l (Bin s k' v' l' r'))
173 (DoubleL k v l (Bin s k' v' l' r'))
175 type family RotateR k v l r
176 type instance RotateR k v (Bin s k' v' l' r') r
177 = If (Size r' :<: (Ratio :*: Size l'))
178 (SingleR k v (Bin s k' v' l' r') r)
179 (DoubleR k v (Bin s k' v' l' r') r)
182 type family SingleL k v l r
183 type instance SingleL k v l (Bin s k' v' l' r')
184 = Bin' k' v' (Bin' k v l l') r'
186 type family SingleR k v l r
187 type instance SingleR k v (Bin s k' v' l r) r'
188 = Bin' k' v' l (Bin' k v r r')
190 type family DoubleL k v l r
191 type instance DoubleL k v l (Bin s k' v' (Bin s' k'' v'' l' r) r')
192 = Bin' k'' v'' (Bin' k v l l') (Bin' k' v' r r')
194 type family DoubleR k v l r
195 type instance DoubleR k v (Bin s k' v' l (Bin s' k'' v'' l' r)) r'
196 = Bin' k'' v'' (Bin' k' v' l l') (Bin' k v r r')
200 = Bin (Size l :+: Size r :+: D1) k v l r
208 (If (Size l :>: Size r)
209 (GlueL (DeleteFindMax l) r)
210 (GlueR l (DeleteFindMin r))))
212 type family GlueL dfm r
213 type instance GlueL (Cons (Cons km m) l') r = Balance km m l' r
215 type family GlueR l dfm
216 type instance GlueR l (Cons (Cons km m) r') = Balance km m l r'
219 type family DeleteFindMin m
220 type instance DeleteFindMin (Bin s k v l r)
223 (DeleteFindMin' k v (DeleteFindMin l) r)
225 type family DeleteFindMin' k v dfm r
226 type instance DeleteFindMin' k v (Cons km l') r
227 = Cons km (Balance k v l' r)
230 type family DeleteFindMax m
231 type instance DeleteFindMax (Bin s k v l r)
234 (DeleteFindMax' k v l (DeleteFindMax r))
236 type family DeleteFindMax' k v l dfm
237 type instance DeleteFindMax' k v l (Cons km r')
238 = Cons km (Balance k v l r')
241 type MinViewWithKey m
244 (Just (DeleteFindMin m))
247 type MaxViewWithKey m
250 (Just (DeleteFindMax m))
256 (Just (View' (DeleteFindMin m)))
259 type instance View' (Cons (Cons k v) m') = Cons v m'
265 (Just (View' (DeleteFindMax m)))
269 = AdjustWithKey (Adjust' f) k m
272 type instance App2 (Adjust' f) k v = App f v
275 type AdjustWithKey f k m
276 = UpdateWithKey (AdjustWithKey' f) k m
278 data AdjustWithKey' f
279 type instance App2 (AdjustWithKey' f) k v = Just (App2 f k v)
282 type family UpdateWithKey f k m
283 type instance UpdateWithKey f k Tip = Tip
284 type instance UpdateWithKey f k (Bin s k' v l r)
286 (Balance k' v (UpdateWithKey f k l) r)
287 (Balance k' v l (UpdateWithKey f k r))
288 (If (IsJust (App2 f k' v))
289 (Bin s k' (FromJust (App2 f k' v)) l r)
293 type MapValue f m = MapWithKey (MapValue' f) m
296 type instance App2 (MapValue' f) k v = App f v
299 type family MapWithKey f m
300 type instance MapWithKey f Tip = Tip
301 type instance MapWithKey f (Bin s k v l r)
302 = Bin s k (App2 f k v) (MapWithKey f l) (MapWithKey f r)
305 type family FoldrWithKey f z m
306 type instance FoldrWithKey f z Tip = z
307 type instance FoldrWithKey f z (Bin s k v l r)
308 = FoldrWithKey f (App3 f k v (FoldrWithKey f z r)) l
311 type family FoldlWithKey f z m
312 type instance FoldlWithKey f z Tip = z
313 type instance FoldlWithKey f z (Bin s k v l r)
314 = FoldlWithKey f (App3 f (FoldlWithKey f z l) k v) r
317 type Keys m = L.Map Key' (Assocs m)
320 type instance App Key' (Cons k v) = k
323 type Assocs m = ToList m
326 type ToList m = ToAscList m
329 type FromList xs = Foldl Ins' Empty xs
332 type instance App2 Ins' m (Cons k v) = Insert k v m
335 type ToAscList m = FoldrWithKey ToAscList' L.Null m
338 type instance App3 ToAscList' k v vs = Cons (Cons k v) vs
341 type ToDescList m = FoldlWithKey ToDescList' L.Null m
344 type instance App3 ToDescList' vs k v = Cons (Cons k v) vs