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

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