diff --git a/rhine/src/Data/Automaton/MSF.hs b/rhine/src/Data/Automaton/MSF.hs
index ddbcdb54..c7dd3418 100644
--- a/rhine/src/Data/Automaton/MSF.hs
+++ b/rhine/src/Data/Automaton/MSF.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE ImportQualifiedPost #-}
@@ -242,7 +243,7 @@ stepMSF (MSF automatonT) a =
 {-# INLINE stepMSF #-}
 
 reactimate :: (Monad m) => MSF m () () -> m void
-reactimate (MSF automaton) = AutomatonOptimized.reactimate $ hoist (`runReaderT` ()) automaton
+reactimate (MSF !automaton) = AutomatonOptimized.reactimate $ hoist (`runReaderT` ()) automaton
 {-# INLINE reactimate #-}
 
 -- FIXME rename to mapMSF? if yes change in document
diff --git a/rhine/src/Data/Automaton/Optimized.hs b/rhine/src/Data/Automaton/Optimized.hs
new file mode 100644
index 00000000..01b0fa3b
--- /dev/null
+++ b/rhine/src/Data/Automaton/Optimized.hs
@@ -0,0 +1,155 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Data.Automaton.Optimized where
+
+-- base
+import Control.Applicative (Alternative (..), liftA2)
+import Data.Monoid (Ap (..))
+
+-- transformers
+import Control.Monad.Trans.Except (ExceptT)
+
+-- selective
+import Control.Selective (Selective (select))
+
+-- simple-affine-space
+import Data.VectorSpace
+
+-- mmorph
+import Control.Monad.Morph
+
+-- rhine
+import Data.Automaton
+import Data.Automaton qualified as AutomatonT
+import Data.Automaton.Final (Final (..))
+import Data.Automaton.Final qualified as Final (fromFinal, toFinal)
+import Data.Automaton.Result
+
+data OptimizedAutomatonT m a
+  = Stateful (AutomatonT m a)
+  | Stateless (m a)
+  deriving (Functor)
+
+toAutomatonT :: (Functor m) => OptimizedAutomatonT m b -> AutomatonT m b
+toAutomatonT (Stateful automaton) = automaton
+toAutomatonT (Stateless m) = AutomatonT {state = (), step = const $ Result () <$> m}
+{-# INLINE toAutomatonT #-}
+
+instance (Applicative m) => Applicative (OptimizedAutomatonT m) where
+  pure = Stateless . pure
+  {-# INLINE pure #-}
+
+  Stateful automaton1 <*> Stateful automaton2 = Stateful $ automaton1 <*> automaton2
+  Stateless m <*> Stateful (AutomatonT state0 step) = Stateful $ AutomatonT state0 $ \state -> fmap . ($) <$> m <*> step state
+  Stateful (AutomatonT state0 step) <*> Stateless m = Stateful $ AutomatonT state0 $ \state -> flip (fmap . flip ($)) <$> step state <*> m
+  Stateless mf <*> Stateless ma = Stateless $ mf <*> ma
+  {-# INLINE (<*>) #-}
+
+deriving via Ap (OptimizedAutomatonT m) a instance (Applicative m, Num a) => Num (OptimizedAutomatonT m a)
+
+instance (Applicative m, Fractional a) => Fractional (OptimizedAutomatonT m a) where
+  fromRational = pure . fromRational
+  recip = fmap recip
+
+instance (Applicative m, Floating a) => Floating (OptimizedAutomatonT m a) where
+  pi = pure pi
+  exp = fmap exp
+  log = fmap log
+  sin = fmap sin
+  cos = fmap cos
+  asin = fmap asin
+  acos = fmap acos
+  atan = fmap atan
+  sinh = fmap sinh
+  cosh = fmap cosh
+  asinh = fmap asinh
+  acosh = fmap acosh
+  atanh = fmap atanh
+
+instance (VectorSpace v s, Eq s, Floating s, Applicative m) => VectorSpace (OptimizedAutomatonT m v) (OptimizedAutomatonT m s) where
+  zeroVector = pure zeroVector
+  (*^) = liftA2 (*^)
+  (^+^) = liftA2 (^+^)
+  dot = liftA2 dot
+  normalize = fmap normalize
+
+instance (Alternative m) => Alternative (OptimizedAutomatonT m) where
+  empty = Stateless empty
+  {-# INLINE empty #-}
+
+  -- The semantics prescribe that we save the state which automaton was selected.
+  automaton1 <|> automaton2 = Stateful $ toAutomatonT automaton1 <|> toAutomatonT automaton2
+  {-# INLINE (<|>) #-}
+
+  many automaton = Stateful $ many $ toAutomatonT automaton
+  {-# INLINE many #-}
+
+  some automaton = Stateful $ some $ toAutomatonT automaton
+  {-# INLINE some #-}
+
+instance (Selective m) => Selective (OptimizedAutomatonT m) where
+  select (Stateless mab) (Stateless f) = Stateless $ select mab f
+  select automaton1 automaton2 = Stateful $ select (toAutomatonT automaton1) (toAutomatonT automaton2)
+
+instance MFunctor OptimizedAutomatonT where
+  hoist f (Stateful automaton) = Stateful $ hoist f automaton
+  hoist f (Stateless m) = Stateless $ f m
+  {-# INLINE hoist #-}
+
+mapOptimizedAutomatonT :: (Functor m, Functor n) => (forall s. m (Result s a) -> n (Result s b)) -> OptimizedAutomatonT m a -> OptimizedAutomatonT n b
+mapOptimizedAutomatonT f (Stateful automaton) = Stateful $ mapAutomatonT f automaton
+mapOptimizedAutomatonT f (Stateless m) = Stateless $ fmap output $ f $ fmap (Result ()) m
+{-# INLINE mapOptimizedAutomatonT #-}
+
+mapS :: (Monad m) => (forall m. (Monad m) => AutomatonT m a -> AutomatonT m b) -> OptimizedAutomatonT m a -> OptimizedAutomatonT m b
+mapS f automaton = Stateful $ f $ toAutomatonT automaton
+
+handleS :: (Functor m) => (AutomatonT m a -> AutomatonT n b) -> OptimizedAutomatonT m a -> OptimizedAutomatonT n b
+handleS f automaton = Stateful $ f $ toAutomatonT automaton
+
+reactimate :: (Monad m) => OptimizedAutomatonT m () -> m void
+reactimate (Stateful !automaton) = AutomatonT.reactimate automaton
+reactimate (Stateless !f) = go
+  where
+    go = f *> go
+{-# INLINE reactimate #-}
+
+constM :: m a -> OptimizedAutomatonT m a
+constM = Stateless
+{-# INLINE constM #-}
+
+stepOptimizedAutomaton :: (Functor m) => OptimizedAutomatonT m a -> m (Result (OptimizedAutomatonT m a) a)
+stepOptimizedAutomaton (Stateful automaton) = mapResultState Stateful <$> stepAutomaton automaton
+stepOptimizedAutomaton oa@(Stateless m) = Result oa <$> m
+{-# INLINE stepOptimizedAutomaton #-}
+
+toFinal :: (Functor m) => OptimizedAutomatonT m a -> Final m a
+toFinal (Stateful automaton) = Final.toFinal automaton
+toFinal (Stateless f) = go
+  where
+    go = Final $ Result go <$> f
+{-# INLINE toFinal #-}
+
+fromFinal :: Final m a -> OptimizedAutomatonT m a
+fromFinal = Stateful . Final.fromFinal
+{-# INLINE fromFinal #-}
+
+concatS :: (Monad m) => OptimizedAutomatonT m [a] -> OptimizedAutomatonT m a
+concatS automaton = Stateful $ AutomatonT.concatS $ toAutomatonT automaton
+{-# INLINE concatS #-}
+
+exceptS :: (Monad m) => OptimizedAutomatonT (ExceptT e m) b -> OptimizedAutomatonT m (Either e b)
+exceptS automaton = Stateful $ AutomatonT.exceptS $ toAutomatonT automaton
+{-# INLINE exceptS #-}
+
+applyExcept :: (Monad m) => OptimizedAutomatonT (ExceptT (e1 -> e2) m) a -> OptimizedAutomatonT (ExceptT e1 m) a -> OptimizedAutomatonT (ExceptT e2 m) a
+applyExcept automatonF automatonA = Stateful $ AutomatonT.applyExcept (toAutomatonT automatonF) (toAutomatonT automatonA)
+{-# INLINE applyExcept #-}
+
+selectExcept :: (Monad m) => OptimizedAutomatonT (ExceptT (Either e1 e2) m) a -> OptimizedAutomatonT (ExceptT (e1 -> e2) m) a -> OptimizedAutomatonT (ExceptT e2 m) a
+selectExcept automatonE automatonF = Stateful $ AutomatonT.selectExcept (toAutomatonT automatonE) (toAutomatonT automatonF)
diff --git a/rhine/src/Data/Stream/Optimized.hs b/rhine/src/Data/Stream/Optimized.hs
index b16d1e2b..75e33a6d 100644
--- a/rhine/src/Data/Stream/Optimized.hs
+++ b/rhine/src/Data/Stream/Optimized.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE RankNTypes #-}
@@ -112,8 +113,8 @@ handleS :: (Functor m) => (StreamT m a -> StreamT n b) -> OptimizedStreamT m a -
 handleS f automaton = Stateful $ f $ toStreamT automaton
 
 reactimate :: (Monad m) => OptimizedStreamT m () -> m void
-reactimate (Stateful automaton) = StreamT.reactimate automaton
-reactimate (Stateless f) = go
+reactimate (Stateful !automaton) = StreamT.reactimate automaton
+reactimate (Stateless !f) = go
   where
     go = f *> go
 {-# INLINE reactimate #-}
diff --git a/rhine/src/FRP/Rhine/Reactimation.hs b/rhine/src/FRP/Rhine/Reactimation.hs
index c27cb003..889e7360 100644
--- a/rhine/src/FRP/Rhine/Reactimation.hs
+++ b/rhine/src/FRP/Rhine/Reactimation.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE GADTs #-}
 
 {- |
@@ -55,7 +56,7 @@ flow ::
   Rhine m cl () () ->
   m void
 flow rhine = do
-  msf <- eraseClock rhine
+  !msf <- eraseClock rhine
   reactimate $ msf >>> arr (const ())
 {-# INLINE flow #-}