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 family CompCase o ifLT ifGT ifEQ
94 type instance CompCase LT ifLT ifGT ifEQ = ifLT
95 type instance CompCase GT ifLT ifGT ifEQ = ifGT
96 type instance CompCase EQ ifLT ifGT ifEQ = ifEQ
99 type family Lookup k m
100 type instance Lookup k Tip = Nothing
101 type instance Lookup k (Bin s k' v l r)
102 = CompCase (Compare k k')
108 type family LookupAssoc k m
109 type instance LookupAssoc k Tip = Nothing
110 type instance LookupAssoc k (Bin s k' v l r)
111 = CompCase (Compare k k')
117 type Member k m = IsJust (Lookup k m)
120 type NotMember k m = Not (Member k m)
123 type Find k m = FromJust (Lookup k m)
126 type FindWithDefault a k m
127 = FromMaybe a (Lookup k m)
133 type Singleton k v = Bin D1 k v Tip Tip
136 type family Insert k v m
137 type instance Insert k v Tip = Singleton k v
138 type instance Insert k v (Bin s k' v' l r)
139 = CompCase (Compare k k')
140 (Balance k' v' (Insert k v l) r)
141 (Balance k' v' l (Insert k v r))
145 type family Delete k m
146 type instance Delete k Tip = Tip
147 type instance Delete k (Bin s k' v l r)
148 = CompCase (Compare k k')
149 (Balance k' v (Delete k l) r)
150 (Balance k' v l (Delete k r))
158 = If ((Size l :+: Size r) :<=: D1)
159 (Bin (SizeX l r) k v l r)
160 (If (Size r :>=: (Delta :*: Size l))
162 (If (Size l :>=: (Delta :*: Size r))
164 (Bin (SizeX l r) k v l r)))
166 type SizeX l r = Size l :+: Size r :+: D1
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)
285 = CompCase (Compare k k')
286 (Balance k' v (UpdateWithKey f k l) r)
287 (Balance k' v l (UpdateWithKey f k r))
288 (UpdateWithKey' s k' (App2 f k' v) l r)
290 type family UpdateWithKey' s k mv l r
291 type instance UpdateWithKey' s k (Just v) l r = Bin s k v l r
292 type instance UpdateWithKey' s k Nothing l r = Glue l r
295 type MapValue f m = MapWithKey (MapValue' f) m
298 type instance App2 (MapValue' f) k v = App f v
301 type family MapWithKey f m
302 type instance MapWithKey f Tip = Tip
303 type instance MapWithKey f (Bin s k v l r)
304 = Bin s k (App2 f k v) (MapWithKey f l) (MapWithKey f r)
307 type family FoldrWithKey f z m
308 type instance FoldrWithKey f z Tip = z
309 type instance FoldrWithKey f z (Bin s k v l r)
310 = FoldrWithKey f (App3 f k v (FoldrWithKey f z r)) l
313 type family FoldlWithKey f z m
314 type instance FoldlWithKey f z Tip = z
315 type instance FoldlWithKey f z (Bin s k v l r)
316 = FoldlWithKey f (App3 f (FoldlWithKey f z l) k v) r
319 type Keys m = L.Map Key' (Assocs m)
322 type instance App Key' (Cons k v) = k
325 type Assocs m = ToList m
328 type ToList m = ToAscList m
331 type FromList xs = Foldl Ins' Empty xs
334 type instance App2 Ins' m (Cons k v) = Insert k v m
337 type ToAscList m = FoldrWithKey ToAscList' L.Null m
340 type instance App3 ToAscList' k v vs = Cons (Cons k v) vs
343 type ToDescList m = FoldlWithKey ToDescList' L.Null m
346 type instance App3 ToDescList' vs k v = Cons (Cons k v) vs