X-Git-Url: https://gerrit.simantics.org/r/gitweb?a=blobdiff_plain;f=bundles%2Forg.simantics.scl.compiler%2Ftests%2Forg%2Fsimantics%2Fscl%2Fcompiler%2Ftests%2Fscl%2FRedBlackTrees.scl;fp=bundles%2Forg.simantics.scl.compiler%2Ftests%2Forg%2Fsimantics%2Fscl%2Fcompiler%2Ftests%2Fscl%2FRedBlackTrees.scl;h=0000000000000000000000000000000000000000;hb=a8758de5bc19e5adb3f618d3038743a164f09912;hp=6f47bd0134ced3394f3da278460d86cc11a3db18;hpb=12d9af17384d960b75d58c3935d2b7b46d93e87b;p=simantics%2Fplatform.git

diff --git a/bundles/org.simantics.scl.compiler/tests/org/simantics/scl/compiler/tests/scl/RedBlackTrees.scl b/bundles/org.simantics.scl.compiler/tests/org/simantics/scl/compiler/tests/scl/RedBlackTrees.scl
deleted file mode 100644
index 6f47bd013..000000000
--- a/bundles/org.simantics.scl.compiler/tests/org/simantics/scl/compiler/tests/scl/RedBlackTrees.scl
+++ /dev/null
@@ -1,101 +0,0 @@
-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