lookupBindGroupOcc: recommend names in the same namespace (#17593)
[ghc.git] / testsuite / tests / perf / should_run / T2902_B_PairingSum.hs
1
2 {-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, FlexibleInstances #-}
3
4 module T2902_B_PairingSum (Sum(..), PSum) where
5
6 import T2902_Sum
7
8 data PSum a b = Empty | Tree a b [PSum a b]
9
10 instance (Ord a, Eq b, Num b) ⇒ Sum PSum a b where
11
12 insert v r = union $ Tree v r []
13
14 union x Empty = x
15 union Empty x = x
16 union x@(Tree v r xs) y@(Tree w s ys) =
17 case compare v w of
18 LT → Tree v r (y:xs)
19 GT → Tree w s (x:ys)
20 EQ → case r + s of
21 0 → z
22 t → insert v t z
23 where z = union (unions xs) (unions ys)
24
25 unions [] = Empty
26 unions [x] = x
27 unions (x : y : zs) = union (union x y) (unions zs)
28
29 extractMin Empty = undefined
30 extractMin (Tree v r xs) = ((v,r), unions xs)
31
32 fromList [] = Empty
33 fromList ((v,r):xs) = insert v r $ fromList xs
34
35 toList Empty = []
36 toList x = let (y, z) = extractMin x in y : toList z
37