-import "Prelude"\r
-\r
-// Version 1, 'untyped'\r
-data Color = R | B \r
-\r
-deriving instance Show Color\r
-\r
-data RB a = E | T Color (RB a) a (RB a)\r
-\r
-rbToList :: RB a -> [a]\r
-rbToList E = []\r
-rbToList (T _ l a r) = rbToList l + [a] + rbToList r\r
-\r
-deriving instance (Show a) => Show (RB a)\r
-\r
-// Insertion and membership test as by Okasaki\r
-insert :: Ord a => a -> RB a -> RB a\r
-insert x s = (match ins s with T _ a z b -> T B a z b) \r
- where\r
- ins E = T R E x E\r
- ins s = match s with\r
- T B a y b ->\r
- if x<y \r
- then balance (ins a) y b\r
- else if x>y \r
- then balance a y (ins b)\r
- else s\r
- T R a y b ->\r
- if x<y\r
- then T R (ins a) y b\r
- else if x>y \r
- then T R a y (ins b)\r
- else s\r
-\r
-member :: Ord a => a -> RB a -> Boolean\r
-member x E = False\r
-member x (T _ a y b)\r
- | x<y = member x a\r
- | x>y = member x b\r
- | otherwise = True\r
-\r
-// balance: first equation is new, to make it work with a weaker invariant\r
-balance :: RB a -> a -> RB a -> RB a\r
-balance (T R a x b) y (T R c z d) = T R (T B a x b) y (T B c z d)\r
-balance (T R (T R a x b) y c) z d = T R (T B a x b) y (T B c z d)\r
-balance (T R a x (T R b y c)) z d = T R (T B a x b) y (T B c z d)\r
-balance a x (T R b y (T R c z d)) = T R (T B a x b) y (T B c z d)\r
-balance a x (T R (T R b y c) z d) = T R (T B a x b) y (T B c z d)\r
-balance a x b = T B a x b\r
-\r
-// deletion a la SMK \r
-delete :: Ord a => a -> RB a -> RB a\r
-delete x t = (match del t with \r
- T _ a y b -> T B a y b\r
- _ -> E)\r
- where\r
- del E = E\r
- del (T _ a y b)\r
- | x<y = delformLeft a y b\r
- | x>y = delformRight a y b\r
- | otherwise = app a b\r
- delformLeft a y b= match a with\r
- T B _ _ _ -> balleft (del a) y b\r
- _ -> T R (del a) y b\r
- delformRight a y b = match b with\r
- T B _ _ _ -> balright a y (del b)\r
- _ -> T R a y (del b)\r
-\r
-balleft :: RB a -> a -> RB a -> RB a\r
-balleft (T R a x b) y c = T R (T B a x b) y c\r
-balleft bl x (T B a y b) = balance bl x (T R a y b)\r
-balleft bl x (T R (T B a y b) z c) = T R (T B bl x a) y (balance b z (sub1 c))\r
-\r
-balright :: RB a -> a -> RB a -> RB a\r
-balright a x (T R b y c) = T R a x (T B b y c)\r
-balright (T B a x b) y bl = balance (T R a x b) y bl\r
-balright (T R a x (T B b y c)) z bl = T R (balance (sub1 a) x b) y (T B c z bl)\r
-\r
-sub1 :: RB a -> RB a\r
-sub1 (T B a x b) = T R a x b\r
-sub1 _ = fail "invariance violation"\r
-\r
-app :: RB a -> RB a -> RB a\r
-app E x = x\r
-app x E = x\r
-app (T R a x b) (T R c y d) =\r
- match app b c with\r
- T R b' z c' -> T R(T R a x b') z (T R c' y d)\r
- bc -> T R a x (T R bc y d)\r
-app (T B a x b) (T B c y d) = \r
- match app b c with\r
- T R b' z c' -> T R(T B a x b') z (T B c' y d)\r
- bc -> balleft a x (T B bc y d)\r
-app a (T R b x c) = T R (app a b) x c\r
-app (T R a x b) c = T R a x (app b c)\r
-\r
-testList = [4,6,2,7,4,7,2,5]\r
-\r
-main = rbToList (foldl (flip insert) E testList)\r
---\r
+import "Prelude"
+
+// Version 1, 'untyped'
+data Color = R | B
+
+deriving instance Show Color
+
+data RB a = E | T Color (RB a) a (RB a)
+
+rbToList :: RB a -> [a]
+rbToList E = []
+rbToList (T _ l a r) = rbToList l + [a] + rbToList r
+
+deriving instance (Show a) => Show (RB a)
+
+// Insertion and membership test as by Okasaki
+insert :: Ord a => a -> RB a -> RB a
+insert x s = (match ins s with T _ a z b -> T B a z b)
+ where
+ ins E = T R E x E
+ ins s = match s with
+ T B a y b ->
+ if x<y
+ then balance (ins a) y b
+ else if x>y
+ then balance a y (ins b)
+ else s
+ T R a y b ->
+ if x<y
+ then T R (ins a) y b
+ else if x>y
+ then T R a y (ins b)
+ else s
+
+member :: Ord a => a -> RB a -> Boolean
+member x E = False
+member x (T _ a y b)
+ | x<y = member x a
+ | x>y = member x b
+ | otherwise = True
+
+// balance: first equation is new, to make it work with a weaker invariant
+balance :: RB a -> a -> RB a -> RB a
+balance (T R a x b) y (T R c z d) = T R (T B a x b) y (T B c z d)
+balance (T R (T R a x b) y c) z d = T R (T B a x b) y (T B c z d)
+balance (T R a x (T R b y c)) z d = T R (T B a x b) y (T B c z d)
+balance a x (T R b y (T R c z d)) = T R (T B a x b) y (T B c z d)
+balance a x (T R (T R b y c) z d) = T R (T B a x b) y (T B c z d)
+balance a x b = T B a x b
+
+// deletion a la SMK
+delete :: Ord a => a -> RB a -> RB a
+delete x t = (match del t with
+ T _ a y b -> T B a y b
+ _ -> E)
+ where
+ del E = E
+ del (T _ a y b)
+ | x<y = delformLeft a y b
+ | x>y = delformRight a y b
+ | otherwise = app a b
+ delformLeft a y b= match a with
+ T B _ _ _ -> balleft (del a) y b
+ _ -> T R (del a) y b
+ delformRight a y b = match b with
+ T B _ _ _ -> balright a y (del b)
+ _ -> T R a y (del b)
+
+balleft :: RB a -> a -> RB a -> RB a
+balleft (T R a x b) y c = T R (T B a x b) y c
+balleft bl x (T B a y b) = balance bl x (T R a y b)
+balleft bl x (T R (T B a y b) z c) = T R (T B bl x a) y (balance b z (sub1 c))
+
+balright :: RB a -> a -> RB a -> RB a
+balright a x (T R b y c) = T R a x (T B b y c)
+balright (T B a x b) y bl = balance (T R a x b) y bl
+balright (T R a x (T B b y c)) z bl = T R (balance (sub1 a) x b) y (T B c z bl)
+
+sub1 :: RB a -> RB a
+sub1 (T B a x b) = T R a x b
+sub1 _ = fail "invariance violation"
+
+app :: RB a -> RB a -> RB a
+app E x = x
+app x E = x
+app (T R a x b) (T R c y d) =
+ match app b c with
+ T R b' z c' -> T R(T R a x b') z (T R c' y d)
+ bc -> T R a x (T R bc y d)
+app (T B a x b) (T B c y d) =
+ match app b c with
+ T R b' z c' -> T R(T B a x b') z (T B c' y d)
+ bc -> balleft a x (T B bc y d)
+app a (T R b x c) = T R (app a b) x c
+app (T R a x b) c = T R a x (app b c)
+
+testList = [4,6,2,7,4,7,2,5]
+
+main = rbToList (foldl (flip insert) E testList)
+--
[2, 4, 5, 6, 7]
\ No newline at end of file
Code Review / simantics / platform.git / blobdiff