]> gerrit.simantics Code Review - simantics/platform.git/blobdiff - tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/FingerTree.scl
(refs #7307) Added features field to SCL module header
[simantics/platform.git] / tests / org.simantics.scl.compiler.tests / src / org / simantics / scl / compiler / tests / scl / FingerTree.scl
index b81f642f6ec727c02bd920cd68a2a82b9fa1bd1b..d967b5bbe7e6c0544a5e3ad42b562c2465ac98a1 100644 (file)
-import "JavaBuiltin" as Java\r
-\r
-main = foldl Java.iadd (0 :: Integer) (concat (concat (Single (1 :: Integer)) \r
-      (Single (2 :: Integer))) (Single (3 :: Integer))) \r
-\r
-data Digit a = Digit1 a\r
-             | Digit2 a a\r
-             | Digit3 a a a\r
-             | Digit4 a a a a\r
-data Node a = Node2 a a | Node3 a a a\r
-data FingerTree a = Empty | Single a | Deep (Digit a) (FingerTree (Node a)) (Digit a)\r
-\r
-insertL :: a -> FingerTree a -> FingerTree a\r
-insertL a Empty      = Single a\r
-insertL a (Single b) = Deep (Digit1 a) Empty (Digit1 b)\r
-insertL a (Deep (Digit1 b) m r) = Deep (Digit2 a b) m r\r
-insertL a (Deep (Digit2 b c) m r) = Deep (Digit3 a b c) m r\r
-insertL a (Deep (Digit3 b c d) m r) = Deep (Digit4 a b c d) m r\r
-insertL a (Deep (Digit4 b c d e) m r) = Deep (Digit2 a b) (insertL (Node3 c d e) m) r\r
-\r
-insertR :: FingerTree a -> a -> FingerTree a\r
-insertR Empty a      = Single a\r
-insertR (Single a) b = Deep (Digit1 a) Empty (Digit1 b)\r
-insertR (Deep l m (Digit1 a)) b = Deep l m (Digit2 a b)\r
-insertR (Deep l m (Digit2 a b)) c = Deep l m (Digit3 a b c)\r
-insertR (Deep l m (Digit3 a b c)) d = Deep l m (Digit4 a b c d)\r
-insertR (Deep l m (Digit4 a b c d)) e = Deep l (insertR m (Node3 a b c)) (Digit2 d e)\r
-\r
-foldl :: (a -> b -> a) -> a -> FingerTree b -> a\r
-foldl f init Empty = init\r
-foldl f init (Single x) = f init x\r
-foldl f init (Deep l m r) = foldlD (foldl foldlN (foldlD init l) m) r\r
-  where\r
-    foldlD init (Digit1 a) = f init a\r
-    foldlD init (Digit2 a b) = f (f init a) b\r
-    foldlD init (Digit3 a b c) = f (f (f init a) b) c\r
-    foldlD init (Digit4 a b c d) = f (f (f (f init a) b) c) d\r
-    \r
-    foldlN init (Node2 a b) = f (f init a) b\r
-    foldlN init (Node3 a b c) = f (f (f init a) b) c\r
-\r
-data View a = Nil | Cons a (FingerTree a)\r
-\r
-viewL :: FingerTree a -> View a\r
-viewL Empty = Nil\r
-viewL (Single a) = Cons a Empty\r
-viewL (Deep (Digit1 a) m r) = Cons a tail\r
-  where\r
-    tail = match viewL m with\r
-        Nil -> digitToFingerTree r\r
-        Cons h t -> Deep (nodeToDigit h) t r\r
-viewL (Deep (Digit2 a b) m r) = Cons a (Deep (Digit1 a) m r)\r
-viewL (Deep (Digit3 a b c) m r) = Cons a (Deep (Digit2 a b) m r)\r
-viewL (Deep (Digit4 a b c d) m r) = Cons a (Deep (Digit3 a b c) m r)\r
-\r
-concat :: FingerTree a -> FingerTree a -> FingerTree a\r
-concat Empty a = a\r
-concat a Empty = a\r
-concat (Single a) b = insertL a b\r
-concat a (Single b) = insertR a b\r
-concat (Deep l1 m1 r1) (Deep l2 m2 r2) = Deep l1 mm r2\r
-  where\r
-    mm = concatAux m1 (digitsToNodes r1 l2) m2\r
-    \r
-// --- Implementation details -------------------------------------------------\r
-\r
-digitToFingerTree :: Digit a -> FingerTree a\r
-digitToFingerTree (Digit1 a)       = Single a\r
-digitToFingerTree (Digit2 a b)     = Deep (Digit1 a)   Empty (Digit1 b)\r
-digitToFingerTree (Digit3 a b c)   = Deep (Digit2 a b) Empty (Digit1 c)\r
-digitToFingerTree (Digit4 a b c d) = Deep (Digit2 a b) Empty (Digit2 c d)\r
-\r
-nodeToDigit :: Node a -> Digit a\r
-nodeToDigit (Node2 a b)   = Digit2 a b\r
-nodeToDigit (Node3 a b c) = Digit3 a b c\r
-    \r
-concatAux :: FingerTree a -> Digit a -> FingerTree a -> FingerTree a\r
-concatAux Empty ds a = insertLD ds a\r
-concatAux a ds Empty = insertRD a ds\r
-concatAux (Single a) ds b = insertL a (insertLD ds b)\r
-concatAux a ds (Single b) = insertR (insertRD a ds) b\r
-concatAux (Deep l1 m1 r1) ds (Deep l2 m2 r2) = Deep l1 mm r2\r
-  where\r
-    mm = concatAux m1 (digitsToNodes3 r1 ds r2) m2\r
-\r
-insertLD :: Digit a -> FingerTree a -> FingerTree a\r
-insertLD (Digit1 a) t = insertL a t\r
-insertLD (Digit2 a b) t = insertL a (insertL b t)\r
-insertLD (Digit3 a b c) t = insertL a (insertL b (insertL c t))\r
-insertLD (Digit4 a b c d) t = insertL a (insertL b (insertL c (insertL d t)))\r
-\r
-insertRD :: FingerTree a -> Digit a -> FingerTree a\r
-insertRD t (Digit1 a) = insertR t a\r
-insertRD t (Digit2 a b) = insertR (insertR t a) b\r
-insertRD t (Digit3 a b c) = insertR (insertR (insertR t a) b) c\r
-insertRD t (Digit4 a b c d) = insertR (insertR (insertR (insertR t a) b) c) d\r
-    \r
-digitsToNodes :: Digit a -> Digit a -> Digit (Node a)\r
-digitsToNodes (Digit1 a) x = dd1 a x\r
-digitsToNodes (Digit2 a b) x = dd2 a b x \r
-digitsToNodes (Digit3 a b c) x = dd3 a b c x\r
-digitsToNodes (Digit4 a b c d) x = dd4 a b c d x \r
-\r
-digitsToNodes3 :: Digit a -> Digit a -> Digit a -> Digit (Node a)\r
-digitsToNodes3 (Digit1 a) x y = ddd1 a x y\r
-digitsToNodes3 (Digit2 a b) x y = ddd2 a b x y\r
-digitsToNodes3 (Digit3 a b c) x y = ddd3 a b c x y\r
-digitsToNodes3 (Digit4 a b c d) x y = ddd4 a b c d x y   \r
-    \r
-d2 a b = Digit1 (Node2 a b)\r
-d3 a b c = Digit1 (Node3 a b c)\r
-d4 a b c d = Digit2 (Node2 a b) (Node2 c d)\r
-d5 a b c d e = Digit2 (Node3 a b c) (Node2 d e)\r
-d6 a b c d e f = Digit2 (Node3 a b c) (Node3 d e f)\r
-d7 a b c d e f g = Digit3 (Node3 a b c) (Node2 d e) (Node2 f g)\r
-d8 a b c d e f g h = Digit3 (Node3 a b c) (Node3 d e f) (Node2 g h)\r
-d9 a b c d e f g h i = Digit3 (Node3 a b c) (Node3 d e f) (Node3 g h i)\r
-d10 a b c d e f g h i j = Digit4 (Node3 a b c) (Node3 d e f) (Node2 g h) (Node2 i j)\r
-d11 a b c d e f g h i j k = Digit4 (Node3 a b c) (Node3 d e f) (Node3 g h i) (Node2 j k)\r
-d12 a b c d e f g h i j k l = Digit4 (Node3 a b c) (Node3 d e f) (Node3 g h i) (Node3 j k l)\r
-\r
-dd1 a (Digit1 b) = d2 a b\r
-dd1 a (Digit2 b c) = d3 a b c\r
-dd1 a (Digit3 b c d) = d4 a b c d\r
-dd1 a (Digit4 b c d e) = d5 a b c d e\r
-dd2 a b (Digit1 c) = d3 a b c\r
-dd2 a b (Digit2 c d) = d4 a b c d\r
-dd2 a b (Digit3 c d e) = d5 a b c d e\r
-dd2 a b (Digit4 c d e f) = d6 a b c d e f\r
-dd3 a b c (Digit1 d) = d4 a b c d\r
-dd3 a b c (Digit2 d e) = d5 a b c d e\r
-dd3 a b c (Digit3 d e f) = d6 a b c d e f\r
-dd3 a b c (Digit4 d e f g) = d7 a b c d e f g\r
-dd4 a b c d (Digit1 e) = d5 a b c d e\r
-dd4 a b c d (Digit2 e f) = d6 a b c d e f\r
-dd4 a b c d (Digit3 e f g) = d7 a b c d e f g\r
-dd4 a b c d (Digit4 e f g h) = d8 a b c d e f g h\r
-dd5 a b c d e (Digit1 f) = d6 a b c d e f\r
-dd5 a b c d e (Digit2 f g) = d7 a b c d e f g\r
-dd5 a b c d e (Digit3 f g h) = d8 a b c d e f g h\r
-dd5 a b c d e (Digit4 f g h i) = d9 a b c d e f g h i\r
-dd6 a b c d e f (Digit1 g) = d7 a b c d e f g\r
-dd6 a b c d e f (Digit2 g h) = d8 a b c d e f g h\r
-dd6 a b c d e f (Digit3 g h i) = d9 a b c d e f g h i\r
-dd6 a b c d e f (Digit4 g h i j) = d10 a b c d e f g h i j\r
-dd7 a b c d e f g (Digit1 h) = d8 a b c d e f g h\r
-dd7 a b c d e f g (Digit2 h i) = d9 a b c d e f g h i\r
-dd7 a b c d e f g (Digit3 h i j) = d10 a b c d e f g h i j\r
-dd7 a b c d e f g (Digit4 h i j k) = d11 a b c d e f g h i j k\r
-dd8 a b c d e f g h (Digit1 i) = d9 a b c d e f g h i\r
-dd8 a b c d e f g h (Digit2 i j) = d10 a b c d e f g h i j\r
-dd8 a b c d e f g h (Digit3 i j k) = d11 a b c d e f g h i j k\r
-dd8 a b c d e f g h (Digit4 i j k l) = d12 a b c d e f g h i j k l\r
-\r
-ddd1 a (Digit1 b) y = dd2 a b y\r
-ddd1 a (Digit2 b c) y = dd3 a b c y\r
-ddd1 a (Digit3 b c d) y = dd4 a b c d y\r
-ddd1 a (Digit4 b c d e) y = dd5 a b c d e y\r
-ddd2 a b (Digit1 c) y = dd3 a b c y\r
-ddd2 a b (Digit2 c d) y = dd4 a b c d y\r
-ddd2 a b (Digit3 c d e) y = dd5 a b c d e y\r
-ddd2 a b (Digit4 c d e f) y = dd6 a b c d e f y\r
-ddd3 a b c (Digit1 d) y = dd4 a b c d y\r
-ddd3 a b c (Digit2 d e) y = dd5 a b c d e y\r
-ddd3 a b c (Digit3 d e f) y = dd6 a b c d e f y\r
-ddd3 a b c (Digit4 d e f g) y = dd7 a b c d e f g y\r
-ddd4 a b c d (Digit1 e) y = dd5 a b c d e y\r
-ddd4 a b c d (Digit2 e f) y = dd6 a b c d e f y\r
-ddd4 a b c d (Digit3 e f g) y = dd7 a b c d e f g y\r
-ddd4 a b c d (Digit4 e f g h) y = dd8 a b c d e f g h y\r
-\r
---\r
+import "JavaBuiltin" as Java
+
+main = foldl Java.iadd (0 :: Integer) (concat (concat (Single (1 :: Integer)) 
+      (Single (2 :: Integer))) (Single (3 :: Integer))) 
+
+data Digit a = Digit1 a
+             | Digit2 a a
+             | Digit3 a a a
+             | Digit4 a a a a
+data Node a = Node2 a a | Node3 a a a
+data FingerTree a = Empty | Single a | Deep (Digit a) (FingerTree (Node a)) (Digit a)
+
+insertL :: a -> FingerTree a -> FingerTree a
+insertL a Empty      = Single a
+insertL a (Single b) = Deep (Digit1 a) Empty (Digit1 b)
+insertL a (Deep (Digit1 b) m r) = Deep (Digit2 a b) m r
+insertL a (Deep (Digit2 b c) m r) = Deep (Digit3 a b c) m r
+insertL a (Deep (Digit3 b c d) m r) = Deep (Digit4 a b c d) m r
+insertL a (Deep (Digit4 b c d e) m r) = Deep (Digit2 a b) (insertL (Node3 c d e) m) r
+
+insertR :: FingerTree a -> a -> FingerTree a
+insertR Empty a      = Single a
+insertR (Single a) b = Deep (Digit1 a) Empty (Digit1 b)
+insertR (Deep l m (Digit1 a)) b = Deep l m (Digit2 a b)
+insertR (Deep l m (Digit2 a b)) c = Deep l m (Digit3 a b c)
+insertR (Deep l m (Digit3 a b c)) d = Deep l m (Digit4 a b c d)
+insertR (Deep l m (Digit4 a b c d)) e = Deep l (insertR m (Node3 a b c)) (Digit2 d e)
+
+foldl :: (a -> b -> a) -> a -> FingerTree b -> a
+foldl f init Empty = init
+foldl f init (Single x) = f init x
+foldl f init (Deep l m r) = foldlD (foldl foldlN (foldlD init l) m) r
+  where
+    foldlD init (Digit1 a) = f init a
+    foldlD init (Digit2 a b) = f (f init a) b
+    foldlD init (Digit3 a b c) = f (f (f init a) b) c
+    foldlD init (Digit4 a b c d) = f (f (f (f init a) b) c) d
+    
+    foldlN init (Node2 a b) = f (f init a) b
+    foldlN init (Node3 a b c) = f (f (f init a) b) c
+
+data View a = Nil | Cons a (FingerTree a)
+
+viewL :: FingerTree a -> View a
+viewL Empty = Nil
+viewL (Single a) = Cons a Empty
+viewL (Deep (Digit1 a) m r) = Cons a tail
+  where
+    tail = match viewL m with
+        Nil -> digitToFingerTree r
+        Cons h t -> Deep (nodeToDigit h) t r
+viewL (Deep (Digit2 a b) m r) = Cons a (Deep (Digit1 a) m r)
+viewL (Deep (Digit3 a b c) m r) = Cons a (Deep (Digit2 a b) m r)
+viewL (Deep (Digit4 a b c d) m r) = Cons a (Deep (Digit3 a b c) m r)
+
+concat :: FingerTree a -> FingerTree a -> FingerTree a
+concat Empty a = a
+concat a Empty = a
+concat (Single a) b = insertL a b
+concat a (Single b) = insertR a b
+concat (Deep l1 m1 r1) (Deep l2 m2 r2) = Deep l1 mm r2
+  where
+    mm = concatAux m1 (digitsToNodes r1 l2) m2
+    
+// --- Implementation details -------------------------------------------------
+
+digitToFingerTree :: Digit a -> FingerTree a
+digitToFingerTree (Digit1 a)       = Single a
+digitToFingerTree (Digit2 a b)     = Deep (Digit1 a)   Empty (Digit1 b)
+digitToFingerTree (Digit3 a b c)   = Deep (Digit2 a b) Empty (Digit1 c)
+digitToFingerTree (Digit4 a b c d) = Deep (Digit2 a b) Empty (Digit2 c d)
+
+nodeToDigit :: Node a -> Digit a
+nodeToDigit (Node2 a b)   = Digit2 a b
+nodeToDigit (Node3 a b c) = Digit3 a b c
+    
+concatAux :: FingerTree a -> Digit a -> FingerTree a -> FingerTree a
+concatAux Empty ds a = insertLD ds a
+concatAux a ds Empty = insertRD a ds
+concatAux (Single a) ds b = insertL a (insertLD ds b)
+concatAux a ds (Single b) = insertR (insertRD a ds) b
+concatAux (Deep l1 m1 r1) ds (Deep l2 m2 r2) = Deep l1 mm r2
+  where
+    mm = concatAux m1 (digitsToNodes3 r1 ds r2) m2
+
+insertLD :: Digit a -> FingerTree a -> FingerTree a
+insertLD (Digit1 a) t = insertL a t
+insertLD (Digit2 a b) t = insertL a (insertL b t)
+insertLD (Digit3 a b c) t = insertL a (insertL b (insertL c t))
+insertLD (Digit4 a b c d) t = insertL a (insertL b (insertL c (insertL d t)))
+
+insertRD :: FingerTree a -> Digit a -> FingerTree a
+insertRD t (Digit1 a) = insertR t a
+insertRD t (Digit2 a b) = insertR (insertR t a) b
+insertRD t (Digit3 a b c) = insertR (insertR (insertR t a) b) c
+insertRD t (Digit4 a b c d) = insertR (insertR (insertR (insertR t a) b) c) d
+    
+digitsToNodes :: Digit a -> Digit a -> Digit (Node a)
+digitsToNodes (Digit1 a) x = dd1 a x
+digitsToNodes (Digit2 a b) x = dd2 a b x 
+digitsToNodes (Digit3 a b c) x = dd3 a b c x
+digitsToNodes (Digit4 a b c d) x = dd4 a b c d x 
+
+digitsToNodes3 :: Digit a -> Digit a -> Digit a -> Digit (Node a)
+digitsToNodes3 (Digit1 a) x y = ddd1 a x y
+digitsToNodes3 (Digit2 a b) x y = ddd2 a b x y
+digitsToNodes3 (Digit3 a b c) x y = ddd3 a b c x y
+digitsToNodes3 (Digit4 a b c d) x y = ddd4 a b c d x y   
+    
+d2 a b = Digit1 (Node2 a b)
+d3 a b c = Digit1 (Node3 a b c)
+d4 a b c d = Digit2 (Node2 a b) (Node2 c d)
+d5 a b c d e = Digit2 (Node3 a b c) (Node2 d e)
+d6 a b c d e f = Digit2 (Node3 a b c) (Node3 d e f)
+d7 a b c d e f g = Digit3 (Node3 a b c) (Node2 d e) (Node2 f g)
+d8 a b c d e f g h = Digit3 (Node3 a b c) (Node3 d e f) (Node2 g h)
+d9 a b c d e f g h i = Digit3 (Node3 a b c) (Node3 d e f) (Node3 g h i)
+d10 a b c d e f g h i j = Digit4 (Node3 a b c) (Node3 d e f) (Node2 g h) (Node2 i j)
+d11 a b c d e f g h i j k = Digit4 (Node3 a b c) (Node3 d e f) (Node3 g h i) (Node2 j k)
+d12 a b c d e f g h i j k l = Digit4 (Node3 a b c) (Node3 d e f) (Node3 g h i) (Node3 j k l)
+
+dd1 a (Digit1 b) = d2 a b
+dd1 a (Digit2 b c) = d3 a b c
+dd1 a (Digit3 b c d) = d4 a b c d
+dd1 a (Digit4 b c d e) = d5 a b c d e
+dd2 a b (Digit1 c) = d3 a b c
+dd2 a b (Digit2 c d) = d4 a b c d
+dd2 a b (Digit3 c d e) = d5 a b c d e
+dd2 a b (Digit4 c d e f) = d6 a b c d e f
+dd3 a b c (Digit1 d) = d4 a b c d
+dd3 a b c (Digit2 d e) = d5 a b c d e
+dd3 a b c (Digit3 d e f) = d6 a b c d e f
+dd3 a b c (Digit4 d e f g) = d7 a b c d e f g
+dd4 a b c d (Digit1 e) = d5 a b c d e
+dd4 a b c d (Digit2 e f) = d6 a b c d e f
+dd4 a b c d (Digit3 e f g) = d7 a b c d e f g
+dd4 a b c d (Digit4 e f g h) = d8 a b c d e f g h
+dd5 a b c d e (Digit1 f) = d6 a b c d e f
+dd5 a b c d e (Digit2 f g) = d7 a b c d e f g
+dd5 a b c d e (Digit3 f g h) = d8 a b c d e f g h
+dd5 a b c d e (Digit4 f g h i) = d9 a b c d e f g h i
+dd6 a b c d e f (Digit1 g) = d7 a b c d e f g
+dd6 a b c d e f (Digit2 g h) = d8 a b c d e f g h
+dd6 a b c d e f (Digit3 g h i) = d9 a b c d e f g h i
+dd6 a b c d e f (Digit4 g h i j) = d10 a b c d e f g h i j
+dd7 a b c d e f g (Digit1 h) = d8 a b c d e f g h
+dd7 a b c d e f g (Digit2 h i) = d9 a b c d e f g h i
+dd7 a b c d e f g (Digit3 h i j) = d10 a b c d e f g h i j
+dd7 a b c d e f g (Digit4 h i j k) = d11 a b c d e f g h i j k
+dd8 a b c d e f g h (Digit1 i) = d9 a b c d e f g h i
+dd8 a b c d e f g h (Digit2 i j) = d10 a b c d e f g h i j
+dd8 a b c d e f g h (Digit3 i j k) = d11 a b c d e f g h i j k
+dd8 a b c d e f g h (Digit4 i j k l) = d12 a b c d e f g h i j k l
+
+ddd1 a (Digit1 b) y = dd2 a b y
+ddd1 a (Digit2 b c) y = dd3 a b c y
+ddd1 a (Digit3 b c d) y = dd4 a b c d y
+ddd1 a (Digit4 b c d e) y = dd5 a b c d e y
+ddd2 a b (Digit1 c) y = dd3 a b c y
+ddd2 a b (Digit2 c d) y = dd4 a b c d y
+ddd2 a b (Digit3 c d e) y = dd5 a b c d e y
+ddd2 a b (Digit4 c d e f) y = dd6 a b c d e f y
+ddd3 a b c (Digit1 d) y = dd4 a b c d y
+ddd3 a b c (Digit2 d e) y = dd5 a b c d e y
+ddd3 a b c (Digit3 d e f) y = dd6 a b c d e f y
+ddd3 a b c (Digit4 d e f g) y = dd7 a b c d e f g y
+ddd4 a b c d (Digit1 e) y = dd5 a b c d e y
+ddd4 a b c d (Digit2 e f) y = dd6 a b c d e f y
+ddd4 a b c d (Digit3 e f g) y = dd7 a b c d e f g y
+ddd4 a b c d (Digit4 e f g h) y = dd8 a b c d e f g h y
+
+--
 6
\ No newline at end of file