automaton/src/Data/Automaton.hs

@@ -257,6 +257,13 @@ instance (Monad m) => ArrowChoice (Automaton m) where
   right (Automaton (Stateless ma)) = Automaton $! Stateless $! ReaderT $! either (pure . Left) (fmap Right . runReaderT ma)
   {-# INLINE right #-}
 
+  f ||| g = f +++ g >>> arr untag
+    where
+      untag (Left x) = x
+      untag (Right y) = y
+
+  {-# INLINE (|||) #-}
+
 -- | Caution, this can make your program hang. Try to use 'feedback' or 'unfold' where possible, or combine 'loop' with 'delay'.
 instance (MonadFix m) => ArrowLoop (Automaton m) where
   loop (Automaton (Stateless ma)) = Automaton $! Stateless $! ReaderT (\b -> fst <$> mfix ((. snd) $ ($ b) $ curry $ runReaderT ma))
@@ -514,10 +521,12 @@ sumS = sumFrom zeroVector
 -- | Sum up all inputs so far, initialised at 0.
 sumN :: (Monad m, Num a) => Automaton m a a
 sumN = arr Sum >>> mappendS >>> arr getSum
+{-# INLINE sumN #-}
 
 -- | Count the natural numbers, beginning at 1.
 count :: (Num n, Monad m) => Automaton m a n
 count = feedback 0 $! arr (\(_, n) -> let n' = n + 1 in (n', n'))
+{-# INLINE count #-}
 
 -- | Remembers the last 'Just' value, defaulting to the given initialisation value.
 lastS :: (Monad m) => a -> Automaton m (Maybe a) a

automaton/src/Data/Stream/Optimized.hs

@@ -168,8 +168,6 @@ reactimate (Stateless f) = go
     go = f *> go
 {-# INLINE reactimate #-}
 
--- reactimateTH 
-
 {- | A stateless stream.
 
 This function is typically preferable over 'Data.Stream.constM',

rhine/bench/Sum.hs

@@ -9,13 +9,12 @@ Most of the implementations really benchmark 'embed', as the lazy list is create
 module Sum where
 
 import "base" Control.Monad (foldM)
-import "base" Data.Either (fromLeft)
 import "base" Data.Functor.Identity
 import "base" Data.Void (absurd)
+
 import "criterion" Criterion.Main
 
 import "automaton" Data.Stream as Stream (StreamT (..))
-import qualified "automaton" Data.Stream as Stream (reactimate)
 import "automaton" Data.Stream.Optimized (OptimizedStreamT (Stateful))
 import "rhine" FRP.Rhine
 
@@ -26,13 +25,9 @@ benchmarks :: Benchmark
 benchmarks =
   bgroup
     "Sum"
-    [ bench "rhine embed" $ nf rhine nMax
+    [ bench "rhine" $ nf rhine nMax
     , bench "rhine flow" $ nf rhineFlow nMax
-    , bench "rhine flow IO" $ nfAppIO rhineMS nMax
-    , bench "automaton embed" $ nf automaton nMax
-    , bench "automatonNoEmbed" $ nf automatonNoEmbed nMax
-    , bench "automatonEmbed" $ nf automatonEmbed nMax
-    , bench "automatonNoEmbedInlined" $ nf automatonNoEmbedInlined nMax
+    , bench "automaton" $ nf automaton nMax
     , bench "direct" $ nf direct nMax
     , bench "direct monad" $ nf directM nMax
     ]
@@ -52,21 +47,6 @@ rhineFlow n =
           then returnA -< ()
           else arrMCl Left -< s
 
-myclock :: IOClock (ExceptT Int IO) (Millisecond 0)
-myclock = ioClock waitClock
-
-rhineMS :: Int -> IO Int
-rhineMS n =
-  fmap (either id absurd) $
-  runExceptT $
-    flow $
-      (@@ myclock) $ proc () -> do
-        k <- count -< ()
-        s <- sumN -< k
-        if k < n
-          then returnA -< ()
-          else throwS -< s
-
 automaton :: Int -> Int
 automaton n = sum $ runIdentity $ embed myCount $ replicate n ()
   where
@@ -79,32 +59,6 @@ automaton n = sum $ runIdentity $ embed myCount $ replicate n ()
             , Stream.step = \s -> return $! Result (s + 1) s
             }
 
-automatonEmbed :: Int -> Int
-automatonEmbed n = fromLeft (error "nope") $ flip embed (repeat ()) $ proc () -> do
-  k <- count -< ()
-  s <- sumN -< k
-  if k < n
-    then returnA -< ()
-    else arrM Left -< s
-
-automatonNoEmbed :: Int -> Int
-automatonNoEmbed n = either id absurd $ reactimate $ proc () -> do
-  k <- count -< ()
-  s <- sumN -< k
-  if k < n
-    then returnA -< ()
-    else arrM Left -< s
-
-automatonNoEmbedInlined :: Int -> Int
-automatonNoEmbedInlined k = either id absurd $ Stream.reactimate StreamT
-            { state = (1, 0)
-            , Stream.step = \(n, s) ->
-              let n' = n + 1
-                  s' = s + n
-              in if n' > k then Left s' else return $! Result (n', s') ()
-            }
-
-
 direct :: Int -> Int
 direct n = sum [0 .. n]
 

rhine/bench/Test.hs

@@ -26,9 +26,6 @@ main =
           "Sum"
           [ testCase "rhine" $ Sum.rhine Sum.nMax @?= Sum.direct Sum.nMax
           , testCase "automaton" $ Sum.automaton Sum.nMax @?= Sum.direct Sum.nMax
-          , testCase "automatonNoEmbed" $ Sum.automatonNoEmbed Sum.nMax @?= Sum.direct Sum.nMax
-          , testCase "automatonEmbed" $ Sum.automatonEmbed Sum.nMax @?= Sum.direct Sum.nMax
-          , testCase "automatonNoEmbedInlined" $ Sum.automatonNoEmbedInlined Sum.nMax @?= Sum.direct Sum.nMax
           , testCase "rhine flow" $ Sum.rhineFlow Sum.nMax @?= Sum.direct Sum.nMax
           ]
       ]

rhine/src/FRP/Rhine/Clock.hs

@@ -148,7 +148,6 @@ instance
       ( runningClock >>> first (arr f)
       , f initTime
       )
-  {-# INLINE initClock #-}
 
 {- | Instead of a mere function as morphism of time domains,
    we can transform one time domain into the other with an effectful morphism.
@@ -206,7 +205,6 @@ instance
       ( runningClock >>> rescaling
       , rescaledInitTime
       )
-  {-# INLINE initClock #-}
 
 -- | A 'RescaledClockM' is trivially a 'RescaledClockS'.
 rescaledClockMToS ::
@@ -244,7 +242,6 @@ instance
       ( hoistS monadMorphism runningClock
       , initialTime
       )
-  {-# INLINE initClock #-}
 
 -- | Lift a clock type into a monad transformer.
 type LiftClock m t cl = HoistClock m (t m) cl

rhine/src/FRP/Rhine/Clock/Realtime.hs

@@ -92,4 +92,3 @@ waitUTC unscaledClockS =
             return (now, (tag, guard (remaining > 0) >> return (fromRational remaining)))
         return (runningClock, initTime)
     }
-{-# INLINE waitUTC #-}

rhine/src/FRP/Rhine/Clock/Realtime/Millisecond.hs

@@ -41,11 +41,9 @@ instance Clock IO (Millisecond n) where
   type Time (Millisecond n) = UTCTime
   type Tag (Millisecond n) = Maybe Double
   initClock (Millisecond cl) = initClock cl <&> first (>>> arr (second snd))
-  {-# INLINE initClock #-}
 
 instance GetClockProxy (Millisecond n)
 
 -- | Tries to achieve real time by using 'waitUTC', see its docs.
 waitClock :: (KnownNat n) => Millisecond n
 waitClock = Millisecond $ waitUTC $ RescaledClock (unyieldClock FixedStep) ((/ 1000) . fromInteger)
-{-# INLINE waitClock #-}

rhine/src/FRP/Rhine/Clock/Unschedule.hs

@@ -43,4 +43,3 @@ instance (TimeDomain (Time cl), Clock (ScheduleT (Diff (Time cl)) m) cl, Monad m
     where
       run :: ScheduleT (Diff (Time cl)) m a -> m a
       run = runScheduleT scheduleWait
-  {-# INLINE initClock #-}