bundles/org.simantics.scl.compiler/tests/org/simantics/scl/compiler/tests/scl/StreamFusion.scl

   1 import "JavaBuiltin" as Java\r
   2 \r
   3 data Either a b = Left a | Right b\r
   4 \r
   5 data Stream a = Stream (s -> Step a s) s\r
   6 data Step a s = Done | Yield a s | Skip s\r
   7 \r
   8 // stream :: [a] -> Stream a\r
   9 // unstream :: Stream a -> [a] \r
  10 // streamRev :: [a] -> Stream a\r
  11 // unstreamRev :: Stream a -> [a]\r
  12 \r
  13 //toStream :: [a] -> Stream a\r
  14 //toStream l = Stream (\i -> if i >= length l then Done else Yield (get l i) (i+1)) 0\r
  15 \r
  16 filterS :: (a -> Boolean) -> Stream a -> Stream a\r
  17 filterS p (Stream next0 s0) = Stream next s0\r
  18   where\r
  19     next s = match next s with\r
  20         Done -> Done\r
  21         Skip s -> Skip s        \r
  22         Yield a s -> if p a then Yield a s else Skip s\r
  23 \r
  24 mapS :: (a -> b) -> Stream a -> Stream b\r
  25 mapS f (Stream next0 s0) = Stream next s0\r
  26   where\r
  27     next s = match next0 s with\r
  28         Done -> Done\r
  29         Skip s -> Skip s        \r
  30         Yield a s -> Yield (f a) s\r
  31       \r
  32 appendS :: Stream a -> Stream a -> Stream a\r
  33 appendS (Stream next1 s1) (Stream next2 s2) = Stream next (Left s1)\r
  34   where\r
  35     next (Left s) = match next1 s with\r
  36         Done -> Skip (Right s2)\r
  37         Skip s -> Skip (Left s)         \r
  38         Yield a s -> Yield a (Left s)\r
  39     next (Right s) = match next2 s with\r
  40         Done -> Done\r
  41         Skip s -> Skip (Right s)    \r
  42         Yield a s -> Yield a (Right s)      \r
  43 \r
  44 decomposeS :: Stream a -> Maybe (a, Stream a)\r
  45 decomposeS (Stream next s0) = loop s0\r
  46   where\r
  47     loop s = match next s with\r
  48         Done -> Nothing\r
  49         Skip s -> loop s\r
  50         Yield a s -> Just (a, Stream next s)    \r
  51 \r
  52 returnS :: a -> Stream a\r
  53 returnS x = Stream next True\r
  54   where \r
  55     next True = Yield x False\r
  56     next False = Done\r
  57     \r
  58 isEmptyS :: Stream a -> Boolean \r
  59 isEmptyS (Stream next s0) = loop s0\r
  60   where\r
  61     loop s = match next s with\r
  62         Done -> True\r
  63         Skip s -> loop s     \r
  64         Yield _ _ -> False\r
  65       \r
  66 foldlS :: (a -> b -> a) -> a -> Stream b -> a\r
  67 foldlS f init (Stream next s0) = go init s0\r
  68   where\r
  69     go cur s = match next s with\r
  70         Done -> cur\r
  71         Skip s -> go cur s\r
  72         Yield x s -> go (f cur x) s\r
  73       \r
  74 scanlS :: (a -> b -> a) -> a -> Stream b -> Stream a\r
  75 scanlS f init (Stream next0 s0) = Stream next (s0, init)\r
  76   where\r
  77     next (s,v) = match next0 s with\r
  78         Done -> Done\r
  79         Skip s -> Skip (s, v)\r
  80         Yield x s -> Yield v (s, f v x)    \r
  81             \r
  82 concatMapS :: (a -> Stream b) -> Stream a -> Stream b\r
  83 concatMapS f (Stream next0 s0) = Stream next (s0, Nothing)\r
  84   where\r
  85     next (s, Nothing) = match next0 s with\r
  86         Done -> Done\r
  87         Skip s -> Skip (s, Nothing)\r
  88         Yield x s -> Skip (s, Just (f x))\r
  89     next (s0, Just (Stream next1 s1)) = match next1 s1 with\r
  90         Done -> Skip (s0, Nothing)\r
  91         Skip s -> Skip (s0, Just (Stream next1 s))\r
  92         Yield x s -> Yield x (s0, Just (Stream next1 s))\r
  93 \r
  94 zipWithS :: (a -> b -> c) -> Stream a -> Stream b -> Stream c\r
  95 zipWithS f (Stream next0 s0) (Stream next1 s1) = Stream next (s0, s1, Nothing)\r
  96   where\r
  97     next (s0, s1, Nothing) = match next0 s0 with\r
  98         Done -> Done\r
  99         Skip s -> Skip (s, s1, Nothing)\r
 100         Yield x s -> Skip (s, s1, Just x)\r
 101     next (s0, s1, Just x) = match next1 s1 with\r
 102         Done -> Done\r
 103         Skip s -> Skip (s0, s, Just x)\r
 104         Yield y s -> Yield (f x y) (s0, s, Nothing)\r
 105 \r
 106 guardS :: Boolean -> Stream a -> Stream a\r
 107 guardS b (Stream next0 s0) = Stream next (b, s0)\r
 108   where\r
 109     next (False, _) = Done\r
 110     next (True, s) = match next0 s with\r
 111         Done -> Done\r
 112         Skip s -> Skip (True, s)\r
 113         Yield x s -> Yield x (True, s)\r
 114 /*\r
 115 takeS :: Integer -> Stream a -> Stream a\r
 116 takeS count (Stream next0 s0) = Stream next (count, s0)\r
 117   where\r
 118     next (count, s) = if count <= 0 then Done\r
 119                       else match next0 s with\r
 120                           Done -> Done\r
 121                         | Skip s -> Skip (count, s)\r
 122                         | Yield x s -> Yield x (count, s)\r
 123 */\r
 124 repeatS :: a -> Stream a\r
 125 repeatS v = Stream next ()\r
 126   where\r
 127     next () = Yield v ()\r
 128 \r
 129 iterateS :: (a -> a) -> a -> Stream a\r
 130 iterateS f v = Stream next v\r
 131   where\r
 132     next v = Yield v (f v)\r
 133   \r
 134 main :: Integer\r
 135 main = foldlS Java.iadd (0 :: Integer) \r
 136               (appendS (appendS (returnS (1 :: Integer)) \r
 137               (returnS (2 :: Integer))) (returnS (3 :: Integer)))\r
 138 --\r
 139 6