Migrated source code from Simantics SVN

[simantics/platform.git] / bundles / org.simantics.scl.compiler / tests / org / simantics / scl / compiler / tests / scl / StreamFusion.scl

diff --git a/bundles/org.simantics.scl.compiler/tests/org/simantics/scl/compiler/tests/scl/StreamFusion.scl b/bundles/org.simantics.scl.compiler/tests/org/simantics/scl/compiler/tests/scl/StreamFusion.scl
new file mode 100644 (file)
index 0000000..6d1864a
--- /dev/null
+++ b/bundles/org.simantics.scl.compiler/tests/org/simantics/scl/compiler/tests/scl/StreamFusion.scl
@@ -0,0 +1,139 @@
+import "JavaBuiltin" as Java\r
+\r
+data Either a b = Left a | Right b\r
+\r
+data Stream a = Stream (s -> Step a s) s\r
+data Step a s = Done | Yield a s | Skip s\r
+\r
+// stream :: [a] -> Stream a\r
+// unstream :: Stream a -> [a] \r
+// streamRev :: [a] -> Stream a\r
+// unstreamRev :: Stream a -> [a]\r
+\r
+//toStream :: [a] -> Stream a\r
+//toStream l = Stream (\i -> if i >= length l then Done else Yield (get l i) (i+1)) 0\r
+\r
+filterS :: (a -> Boolean) -> Stream a -> Stream a\r
+filterS p (Stream next0 s0) = Stream next s0\r
+  where\r
+    next s = match next s with\r
+        Done -> Done\r
+        Skip s -> Skip s        \r
+        Yield a s -> if p a then Yield a s else Skip s\r
+\r
+mapS :: (a -> b) -> Stream a -> Stream b\r
+mapS f (Stream next0 s0) = Stream next s0\r
+  where\r
+    next s = match next0 s with\r
+        Done -> Done\r
+        Skip s -> Skip s        \r
+        Yield a s -> Yield (f a) s\r
+      \r
+appendS :: Stream a -> Stream a -> Stream a\r
+appendS (Stream next1 s1) (Stream next2 s2) = Stream next (Left s1)\r
+  where\r
+    next (Left s) = match next1 s with\r
+        Done -> Skip (Right s2)\r
+        Skip s -> Skip (Left s)         \r
+        Yield a s -> Yield a (Left s)\r
+    next (Right s) = match next2 s with\r
+        Done -> Done\r
+        Skip s -> Skip (Right s)    \r
+        Yield a s -> Yield a (Right s)      \r
+\r
+decomposeS :: Stream a -> Maybe (a, Stream a)\r
+decomposeS (Stream next s0) = loop s0\r
+  where\r
+    loop s = match next s with\r
+        Done -> Nothing\r
+        Skip s -> loop s\r
+        Yield a s -> Just (a, Stream next s)    \r
+\r
+returnS :: a -> Stream a\r
+returnS x = Stream next True\r
+  where \r
+    next True = Yield x False\r
+    next False = Done\r
+    \r
+isEmptyS :: Stream a -> Boolean \r
+isEmptyS (Stream next s0) = loop s0\r
+  where\r
+    loop s = match next s with\r
+        Done -> True\r
+        Skip s -> loop s     \r
+        Yield _ _ -> False\r
+      \r
+foldlS :: (a -> b -> a) -> a -> Stream b -> a\r
+foldlS f init (Stream next s0) = go init s0\r
+  where\r
+    go cur s = match next s with\r
+        Done -> cur\r
+        Skip s -> go cur s\r
+        Yield x s -> go (f cur x) s\r
+      \r
+scanlS :: (a -> b -> a) -> a -> Stream b -> Stream a\r
+scanlS f init (Stream next0 s0) = Stream next (s0, init)\r
+  where\r
+    next (s,v) = match next0 s with\r
+        Done -> Done\r
+        Skip s -> Skip (s, v)\r
+        Yield x s -> Yield v (s, f v x)    \r
+            \r
+concatMapS :: (a -> Stream b) -> Stream a -> Stream b\r
+concatMapS f (Stream next0 s0) = Stream next (s0, Nothing)\r
+  where\r
+    next (s, Nothing) = match next0 s with\r
+        Done -> Done\r
+        Skip s -> Skip (s, Nothing)\r
+        Yield x s -> Skip (s, Just (f x))\r
+    next (s0, Just (Stream next1 s1)) = match next1 s1 with\r
+        Done -> Skip (s0, Nothing)\r
+        Skip s -> Skip (s0, Just (Stream next1 s))\r
+        Yield x s -> Yield x (s0, Just (Stream next1 s))\r
+\r
+zipWithS :: (a -> b -> c) -> Stream a -> Stream b -> Stream c\r
+zipWithS f (Stream next0 s0) (Stream next1 s1) = Stream next (s0, s1, Nothing)\r
+  where\r
+    next (s0, s1, Nothing) = match next0 s0 with\r
+        Done -> Done\r
+        Skip s -> Skip (s, s1, Nothing)\r
+        Yield x s -> Skip (s, s1, Just x)\r
+    next (s0, s1, Just x) = match next1 s1 with\r
+        Done -> Done\r
+        Skip s -> Skip (s0, s, Just x)\r
+        Yield y s -> Yield (f x y) (s0, s, Nothing)\r
+\r
+guardS :: Boolean -> Stream a -> Stream a\r
+guardS b (Stream next0 s0) = Stream next (b, s0)\r
+  where\r
+    next (False, _) = Done\r
+    next (True, s) = match next0 s with\r
+        Done -> Done\r
+        Skip s -> Skip (True, s)\r
+        Yield x s -> Yield x (True, s)\r
+/*\r
+takeS :: Integer -> Stream a -> Stream a\r
+takeS count (Stream next0 s0) = Stream next (count, s0)\r
+  where\r
+    next (count, s) = if count <= 0 then Done\r
+                      else match next0 s with\r
+                          Done -> Done\r
+                        | Skip s -> Skip (count, s)\r
+                        | Yield x s -> Yield x (count, s)\r
+*/\r
+repeatS :: a -> Stream a\r
+repeatS v = Stream next ()\r
+  where\r
+    next () = Yield v ()\r
+\r
+iterateS :: (a -> a) -> a -> Stream a\r
+iterateS f v = Stream next v\r
+  where\r
+    next v = Yield v (f v)\r
+  \r
+main :: Integer\r
+main = foldlS Java.iadd (0 :: Integer) \r
+              (appendS (appendS (returnS (1 :: Integer)) \r
+              (returnS (2 :: Integer))) (returnS (3 :: Integer)))\r
+--\r
+6
\ No newline at end of file