X-Git-Url: https://gerrit.simantics.org/r/gitweb?p=simantics%2Fplatform.git;a=blobdiff_plain;f=tests%2Forg.simantics.scl.compiler.tests%2Fsrc%2Forg%2Fsimantics%2Fscl%2Fcompiler%2Ftests%2Fscl%2FFingerTree.scl;h=d967b5bbe7e6c0544a5e3ad42b562c2465ac98a1;hp=b81f642f6ec727c02bd920cd68a2a82b9fa1bd1b;hb=172abed5dbf73c1304a7a95bb8504ea293556948;hpb=e67e00d01d30f362e7a4f599cbcf24770ce13e22 diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/FingerTree.scl b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/FingerTree.scl index b81f642f6..d967b5bbe 100644 --- a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/FingerTree.scl +++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/FingerTree.scl @@ -1,173 +1,173 @@ -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 - --- +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