diff --git a/machinecell.cabal b/machinecell.cabal
--- a/machinecell.cabal
+++ b/machinecell.cabal
@@ -1,5 +1,5 @@
 name:                machinecell
-version:             2.1.0
+version:             3.0.0
 synopsis:            Arrow based stream transducers
 license:             BSD3
 license-file:        LICENSE
@@ -53,4 +53,4 @@
 source-repository this
   type:		git
   location:	https://github.com/as-capabl/machinecell.git
-  tag:		release-2.1.0
+  tag:		release-3.0.0
diff --git a/src/Control/Arrow/Machine.hs b/src/Control/Arrow/Machine.hs
--- a/src/Control/Arrow/Machine.hs
+++ b/src/Control/Arrow/Machine.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE Safe #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE Arrows #-}
 {-# LANGUAGE RankNTypes #-}
diff --git a/src/Control/Arrow/Machine/ArrowUtil.hs b/src/Control/Arrow/Machine/ArrowUtil.hs
--- a/src/Control/Arrow/Machine/ArrowUtil.hs
+++ b/src/Control/Arrow/Machine/ArrowUtil.hs
@@ -2,6 +2,11 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE Arrows #-}
 
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE Safe #-}
+#else
+{-# LANGUAGE Trustworthy #-}
+#endif
 
 -- | Arrow utilities not related to machinecell library.
 module
@@ -27,7 +32,22 @@
         reading,
         statefully,
 
-        -- * To absorve arrow stack signature difference bettween ghc 7.8 and older.
+        -- * Arrow construction helper (Lens)
+        -- |Lens Isomorphisms between arrows and monads.
+        -- All definitions are defined arrow->monad directions.
+        -- Use with lens operator (^.) and (#).
+        kl,
+        am,
+        rd,
+        uc0,
+        uc1,
+        uc2,
+        uc3,
+        uc4,
+        uc5,
+
+        -- * Custom arrow syntax helper
+        -- |To absorve arrow stack signature difference bettween ghc 7.8 and older.
         AS,
         toAS,
         fromAS,
@@ -36,13 +56,17 @@
     )
 where
 
+import Prelude hiding ((.), id)
+import Control.Category
 import Control.Arrow
-import Control.Arrow.Operations (readState, store, fetch)
-import Control.Arrow.Transformer.Reader
+import Control.Arrow.Operations (store, fetch)
+import Control.Arrow.Transformer.Reader 
 import Control.Arrow.Transformer.State
-import Control.Monad.Reader (ReaderT, runReaderT)
+import Control.Monad.Reader (ReaderT(..), runReaderT)
 import Control.Monad.State (StateT, runStateT)
+import Data.Profunctor
 
+       
 #if __GLASGOW_HASKELL__ >= 708
 
 type AS e = (e, ())
@@ -137,10 +161,7 @@
     (forall p q. (p->m q)->a p q) -> 
     (b -> ReaderT r m c) ->
     ReaderArrow r a b c
-reading f mr = proc x ->
-  do
-    r <- readState -< ()
-    liftReader (f $ \(x, r) -> runReaderT (mr x) r) -< (x, r)
+reading f mr = ReaderArrow . f $ uncurry (runReaderT . mr)
 
 statefully ::
     (Monad m, Arrow a) =>
@@ -155,9 +176,69 @@
     returnA -< y
     
 
+type MyIso s t a b =
+    forall p f. (Profunctor p, Functor f) =>
+    p a (f b) -> p s (f t)
+
+type MyIso' s a = MyIso s s a a
+
+myIso ::
+    (s -> a) -> (b -> t) -> MyIso s t a b
+myIso sa bt = dimap sa (fmap bt)
+
+-- |Isomorphsm between m and (Kleisli m)
+kl ::
+    MyIso' (a -> m b) (Kleisli m a b)
+kl = myIso Kleisli runKleisli
+
+-- |Isomorphism between (ArrowMonad a) and a
+am ::
+    ArrowApply a =>
+    MyIso' (b -> ArrowMonad a c) (a b c)
+am = myIso unArrowMonad arrowMonad
+
+rd ::
+    (Arrow a) =>
+    (forall p q. MyIso' (p -> m q) (a p q)) ->
+    MyIso' (b -> ReaderT r m c) (ReaderArrow r a b c)
+rd f = e . f . g
+  where
+    e = myIso
+        (\frmy -> uncurry (runReaderT . frmy))
+        (\fmy -> ReaderT . (curry fmy))
+    g = myIso ReaderArrow runReader
+
+uc0 :: MyIso' (m b) (() -> m b)
+uc0 = myIso const ($())
+
+uc1 :: MyIso' (a1 -> m b) (a1 -> m b)
+uc1 = id
+
+uc2 :: MyIso' (a1 -> a2 -> m b) ((a1, a2) -> m b)
+uc2 = myIso
+    (\f (a1, a2) -> f a1 a2)
+    (\f a1 a2 -> f (a1, a2))
+
+uc3 :: MyIso' (a1 -> a2 -> a3 -> m b) ((a1, a2, a3) -> m b)
+uc3 = myIso
+    (\f (a1, a2, a3) -> f a1 a2 a3)
+    (\f a1 a2 a3 -> f (a1, a2, a3))
+
+uc4 :: MyIso' (a1 -> a2 -> a3 -> a4 -> m b) ((a1, a2, a3, a4) -> m b)
+uc4 = myIso
+    (\f (a1, a2, a3, a4) -> f a1 a2 a3 a4)
+    (\f a1 a2 a3 a4 -> f (a1, a2, a3, a4))
+
+uc5 :: MyIso' (a1 -> a2 -> a3 -> a4 -> a5 -> m b) ((a1, a2, a3, a4, a5) -> m b)
+uc5 = myIso
+    (\f (a1, a2, a3, a4, a5) -> f a1 a2 a3 a4 a5)
+    (\f a1 a2 a3 a4 a5 -> f (a1, a2, a3, a4, a5))
+
 -- |Alternate for `elimReader` that can be used with both ghc 7.8 and older.
 elimR ::
     ArrowAddReader r a a' =>
     a (AS e) b -> a' (e, AS r) b
 elimR f =
     second (arr $ fromAS) >>> elimReader (arr toAS >>> f)
+
+
diff --git a/src/Control/Arrow/Machine/Misc/Discrete.hs b/src/Control/Arrow/Machine/Misc/Discrete.hs
--- a/src/Control/Arrow/Machine/Misc/Discrete.hs
+++ b/src/Control/Arrow/Machine/Misc/Discrete.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE Safe #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE Arrows #-}
 {-# LANGUAGE RankNTypes #-}
diff --git a/src/Control/Arrow/Machine/Misc/Exception.hs b/src/Control/Arrow/Machine/Misc/Exception.hs
--- a/src/Control/Arrow/Machine/Misc/Exception.hs
+++ b/src/Control/Arrow/Machine/Misc/Exception.hs
@@ -1,4 +1,4 @@
-
+{-# LANGUAGE Safe #-}
 
 module
     Control.Arrow.Machine.Misc.Exception
diff --git a/src/Control/Arrow/Machine/Misc/Pump.hs b/src/Control/Arrow/Machine/Misc/Pump.hs
--- a/src/Control/Arrow/Machine/Misc/Pump.hs
+++ b/src/Control/Arrow/Machine/Misc/Pump.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE Safe #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE Arrows #-}
 {-# LANGUAGE RankNTypes #-}
@@ -24,7 +25,7 @@
 where
 
 import Prelude hiding (id, (.))
-import Data.Functor
+import Data.Functor ((<$), (<$>))
 import Control.Category
 import Control.Arrow
 import qualified Control.Arrow.Machine as P
diff --git a/src/Control/Arrow/Machine/Types.hs b/src/Control/Arrow/Machine/Types.hs
--- a/src/Control/Arrow/Machine/Types.hs
+++ b/src/Control/Arrow/Machine/Types.hs
@@ -1,29 +1,41 @@
+{-# LANGUAGE Trustworthy #-} -- Safe if eliminate GeneralizedNewtypeInstance
 {-# LANGUAGE Arrows #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module
     Control.Arrow.Machine.Types
       (
-        -- * Basic types
+        -- * Stream transducer type
         ProcessA(),
 
+        -- * Event type and utility
         Occasional' (..),
         Occasional (..),
         Event (),
         condEvent,
         filterEvent,
+        filterJust,
+        filterLeft,
+        filterRight,
         evMap,
         
-        -- * Plan monads
-        PlanT,
+        -- * Coroutine monad
+        -- | Procedural coroutine monad that can await or yield values.
+        --
+        -- Coroutines can be encoded to machines by `constructT` or so on and
+        -- then put into `ProcessA` compositions.
+        PlanT(..),
         Plan,
 
         await,
@@ -67,33 +79,30 @@
         rpSwitchB,
         par,
         parB,
-
         
         -- * Primitive machines - other safe primitives
         fit,
-        loop',
+        fitW,
         
         -- * Primitive machines - unsafe
-        fitEx,
-        unsafeSteady,
         unsafeExhaust,
       )
 where
 
 import qualified Control.Category as Cat
 import Data.Profunctor (Profunctor, dimap, rmap)
-import Control.Arrow.Operations (ArrowReader(..))
-import Control.Arrow.Transformer.Reader (ArrowAddReader(..))
 import Control.Arrow
-import Control.Monad hiding (join)
+import Control.Monad
 import Control.Monad.Trans
-import Control.Monad.State hiding (join)
-import Control.Monad.Writer hiding ((<>), join)
-import Control.Applicative hiding (pure)
-import qualified Control.Applicative as Ap
+import Control.Monad.State
+import Control.Monad.Reader
+import Control.Monad.Writer hiding ((<>))
+import Control.Monad.Identity
+import Control.Applicative
 import Data.Foldable as Fd
 import Data.Traversable as Tv
 import Data.Semigroup (Semigroup, (<>))
+import Data.Maybe (fromMaybe, isNothing, isJust)
 import qualified Control.Monad.Trans.Free as F
 import qualified Control.Monad.Trans.Free.Church as F
 import Control.Arrow.Machine.ArrowUtil
@@ -117,60 +126,107 @@
     mappend Sweep Sweep = Sweep
 
 
-type StepType a b c = a (Phase, b) (Phase, c, ProcessA a b c) 
+type ProcType a b c = ProcessA a b c
 
 -- | The stream transducer arrow.
 --
 -- To construct `ProcessA` instances, use `Control.Arrow.Machine.Plan.Plan`,
 -- `arr`, functions declared in `Control.Arrow.Machine.Utils`,
 -- or arrow combinations of them.
-newtype ProcessA a b c = ProcessA { 
-      step :: StepType a b c
-    }
+--
+-- See an introduction at "Control.Arrow.Machine" documentation.
+data ProcessA a b c = ProcessA {
+    feed :: a b (c, ProcessA a b c),
+    sweep :: a b (Maybe c, ProcessA a b c),
+    suspend :: !(b -> c)
+  }
 
 
-fitEx :: (Arrow a, Arrow a') =>
-    (forall p q. a (p, b) (q, c) -> a' (p, b') (q, c')) ->
-    ProcessA a b c ->
-    ProcessA a' b' c'
-fitEx f k = ProcessA $ proc (ph, x) ->
-  do
-    ((ph', k'), y) <- f (step k >>> arr (\(ph', y, k') -> ((ph', k'), y))) -< (ph, x)
-    returnA -< (ph', y, fitEx f k')
-
+-- For internal use
+class
+    (Applicative f, Monad f) => ProcessHelper f
+  where
+    step :: ArrowApply a => ProcessA a b c -> a b (f c, ProcessA a b c)
+    helperToMaybe :: f a -> Maybe a
+    weakly :: a -> f a
+  
+    step' :: ArrowApply a => ProcessA a b c -> a (f b) (f c, ProcessA a b c)
+    step' pa = proc hx ->
+      do
+        let mx = helperToMaybe hx
+        maybe
+            (arr $ const (suspend pa <$> hx, pa))
+            (\x -> proc _ -> step pa -< x)
+            mx
+                -<< ()
 
-fit :: (Arrow a, Arrow a') => 
-       (forall p q. a p q -> a' p q) -> 
-       ProcessA a b c -> ProcessA a' b c
-fit f = fitEx f
+instance
+    ProcessHelper Identity
+  where
+    step pa = feed pa >>> first (arr Identity)
+    helperToMaybe = Just . runIdentity
+    weakly = Identity
 
+instance
+    ProcessHelper Maybe
+  where
+    step = sweep
+    helperToMaybe = id
+    weakly _ = Nothing
 
-loop' :: ArrowApply a =>
-    d ->
-    ProcessA a (b, d) (c, d) ->
+makePA ::
+    Arrow a =>
+    (forall f. ProcessHelper f =>
+        a b (f c, ProcessA a b c)) ->
+    (b -> c) ->
     ProcessA a b c
-loop' i pa = ProcessA $ proc (ph, x) ->
-  do
-    (ph', (y, n), pa') <- step pa -< (ph, (x, i))
-    returnA -< (ph', y, loop' n pa')
+makePA h sus = ProcessA {
+    feed = h >>> first (arr runIdentity),
+    sweep = h,
+    suspend = sus
+  }
+            
+       
+-- |Natural transformation
+fit ::
+    (ArrowApply a, ArrowApply a') => 
+    (forall p q. a p q -> a' p q) -> 
+    ProcessA a b c -> ProcessA a' b c
+fit f pa =
+    arr Identity >>>
+    fitW runIdentity (\ar -> arr runIdentity >>> f ar) pa
 
+-- |Experimental: more general fit.
+--
+-- Should w be a comonad?
+fitW :: (ArrowApply a, ArrowApply a', Functor w) =>
+    (forall p. w p -> p) ->
+    (forall p q. a p q -> a' (w p) q) -> 
+    ProcessA a b c -> ProcessA a' (w b) c
+fitW extr f pa = makePA
+    (f (step pa) >>> arr (second $ fitW extr f))
+    (extr >>> suspend pa)
+
+
 instance
-    Arrow a => Profunctor (ProcessA a)
+    ArrowApply a => Profunctor (ProcessA a)
   where
-    dimap f g pa = ProcessA $ dimapStep f g (step pa)
+    dimap = dimapProc
     {-# INLINE dimap #-}
 
-dimapStep :: Arrow a => 
-             (b->c)->(d->e)->
-             StepType a c d -> StepType a b e
-dimapStep f g stp = proc (ph, x) ->
-  do
-    (ph', y, pa') <- stp -< (ph, f x)
-    returnA -< (ph', g y, dimap f g pa')
-{-# NOINLINE dimapStep #-}
+dimapProc ::
+    ArrowApply a => 
+    (b->c)->(d->e)->
+    ProcType a c d -> ProcType a b e
+dimapProc f g pa = makePA
+    (arr f >>> step pa >>> (arr (fmap g) *** arr (dimapProc f g)))
+    (dimap f g (suspend pa))
 
+{-# NOINLINE dimapProc #-}
+
+
 instance
-    Arrow a => Functor (ProcessA a i)
+    ArrowApply a => Functor (ProcessA a i)
   where
     fmap = rmap
 
@@ -180,202 +236,185 @@
     pure = arr . const
     pf <*> px = (pf &&& px) >>> arr (uncurry ($))
 
-      
+
 instance
     ArrowApply a => Cat.Category (ProcessA a)
   where
-    id = ProcessA idStep
+    id = idProc
     {-# INLINE id #-}
-    g . f = ProcessA $ compositeStep (step f) (step g)
+    g . f = compositeProc f g
     {-# INLINE (.) #-}
 
 
 instance 
     ArrowApply a => Arrow (ProcessA a)
   where
-    arr = ProcessA . arrStep
+    arr = arrProc
     {-# INLINE arr #-}
 
-    first pa = ProcessA $ parStep (step pa) idStep
+    first pa = parProc pa idProc
     {-# INLINE first #-}
 
-    second pa = ProcessA $ parStep idStep (step pa)
+    second pa = parProc idProc pa
     {-# INLINE second #-}
 
-    pa *** pb = ProcessA $ parStep (step pa) (step pb)
+    (***) = parProc
     {-# INLINE (***) #-}
 
 
-parStep :: ArrowApply a =>
-    StepType a b c ->
-    StepType a d e ->
-    StepType a (b, d) (c, e)
-parStep f g = proc (ph, (x1, x2)) ->
-  do
-    (ph1, y1, pa') <- f -< (ph, x1)
-    (ph2, y2, pb') <- g -< (ph, x2)
-    returnA -< (ph1 `mappend` ph2, (y1, y2), pa' *** pb')
-{-# NOINLINE parStep #-}
-
-idStep :: ArrowApply a => StepType a b b
-idStep = proc (ph, x) ->
-    returnA -< (ph `mappend` Suspend, x, ProcessA $ idStep)
-{-# NOINLINE idStep #-}
+parProc :: ArrowApply a =>
+    ProcType a b c ->
+    ProcType a d e ->
+    ProcType a (b, d) (c, e)
+parProc f g = ProcessA {
+    feed = proc (x1, x2) ->
+      do
+        (y1, f') <- feed f -< x1
+        (y2, g') <- feed g -< x2
+        returnA -< ((y1, y2), parProc f' g'),
+    sweep = proc (x1, x2) ->
+      do
+        (my1, f') <- sweep f -< x1
+        (my2, g') <- sweep g -< x2
+        let y1 = fromMaybe (suspend f' x1) my1 -- suspend f ?
+            y2 = fromMaybe (suspend g' x2) my2
+            r = if (isNothing my1 && isNothing my2) then Nothing else Just (y1, y2)
+        returnA -< (r, parProc f' g'),
+    suspend = suspend f *** suspend g
+  }
+{-# NOINLINE parProc #-}
 
-arrStep :: ArrowApply a => (b->c) -> StepType a b c
-arrStep f = proc (ph, x) ->
-    returnA -< (ph `mappend` Suspend, f x, ProcessA $ arrStep f)
-{-# NOINLINE arrStep #-}
+idProc :: ArrowApply a => ProcType a b b
+idProc = makePA (arr $ \x -> (weakly x, idProc)) id
+{-# NOINLINE idProc #-}
 
+arrProc :: ArrowApply a => (b->c) -> ProcType a b c
+arrProc f = makePA (arr $ \x -> (weakly (f x), arrProc f)) f
+{-# NOINLINE arrProc #-}
 
 -- |Composition is proceeded by the backtracking strategy.
-compositeStep :: ArrowApply a => 
-              StepType a b d -> StepType a d c -> StepType a b c
-compositeStep f g = proc (ph, x) -> compositeStep' ph f g -<< (ph, x)
-{-# NOINLINE compositeStep #-}
-
-compositeStep' :: ArrowApply a => 
-              Phase -> 
-              StepType a b d -> StepType a d c -> StepType a b c
-             
-compositeStep' Sweep f g = proc (_, x) ->
-  do
-    (_, r1, pa') <- f -< (Suspend, x)
-    (ph2, r2, pb') <- g -<< (Sweep, r1)
-    cont ph2 -<< (r2, pa', pb', x)
+compositeProc :: ArrowApply a => 
+              ProcType a b d -> ProcType a d c -> ProcType a b c
+compositeProc f0 g0 = ProcessA {
+    feed = proc x ->
+      do
+        (y, f') <- feed f0 -< x
+        (z, g') <- feed g0 -< y
+        returnA -< (z, compositeProc f' g'),
+    sweep = proc x ->
+      do
+        (mz, g') <- sweep g0 -< suspend f0 x
+        (case mz
+          of
+            Just z -> arr $ const (Just z, compositeProc f0 g')
+            Nothing -> btrk f0 g')
+                -<< x,
+    suspend = suspend f0 >>> suspend g0
+  }
   where
-    cont Feed = arr $ \(r, pa, pb, _) -> (Feed, r, pa >>> pb)
-    cont Sweep = arr $ \(r, pa, pb, _) -> (Sweep, r, pa >>> pb)
-    cont Suspend = proc (r, pa, pb, x) ->
+    btrk f g = proc x ->
       do
-        (ph1, r1, pa') <- step pa -<< (Sweep, x)
-        (ph2, r2, pb') <-
-            (if ph1 == Feed
-                then
-                  step pb
-                else
-                  arr $ const (Suspend, r, pb))
-                      -<< (ph1, r1)
-        returnA -< (ph2, r2, pa' >>> pb')
+        (my, f') <- sweep f -< x
+        (mz, g') <-
+            (case my
+              of
+                Just y -> proc () ->
+                  do
+                    (z, g') <- feed g -< y
+                    returnA -< (Just z, g')
+                Nothing -> proc () ->
+                  do
+                    returnA -< (Nothing, g))
+                -<< ()
+        returnA -< (mz, compositeProc f' g')
 
-compositeStep' ph f g = proc (_, x) ->
-  do
-    (ph1, r1, pa') <- f -< (ph, x)
-    (ph2, r2, pb') <- g -<< (ph1, r1)
-    returnA -< (ph2, r2, pa' >>> pb')
+{-# NOINLINE compositeProc #-}
 
 -- rules
 {-# RULES
 "ProcessA: id/*"
-    forall g. compositeStep idStep g = g
+    forall g. compositeProc idProc g = g
 "ProcessA: */id"
-    forall f. compositeStep f idStep = f
+    forall f. compositeProc f idProc = f
 
 "ProcessA: concat/concat" 
-    forall f g h. compositeStep (compositeStep f g) h = compositeStep f (compositeStep g h)
+    forall f g h. compositeProc (compositeProc f g) h = compositeProc f (compositeProc g h)
 
 "ProcessA: dimap/dimap"
-    forall f g h i j. dimapStep f j (dimapStep g i h)  = dimapStep (g . f) (j . i) h
+    forall f g h i j. dimapProc f j (dimapProc g i h)  = dimapProc (g . f) (j . i) h
 "ProcessA: dimap/arr"
-    forall f g h. dimapStep f h (arrStep g) = arrStep (h . g . f)
+    forall f g h. dimapProc f h (arrProc g) = arrProc (h . g . f)
 
 "ProcessA: arr***/par"
-    forall f1 f2 g1 g2 h. compositeStep (parStep f1 (arrStep f2)) (compositeStep (parStep g1 g2) h) =
-        compositeStep (parStep (compositeStep f1 g1) (dimapStep f2 id g2)) h
+    forall f1 f2 g1 g2 h. compositeProc (parProc f1 (arrProc f2)) (compositeProc (parProc g1 g2) h) =
+        compositeProc (parProc (compositeProc f1 g1) (dimapProc f2 id g2)) h
 "ProcessA: arr***/par-2"
-    forall f1 f2 g1 g2. compositeStep (parStep f1 (arrStep f2)) (parStep g1 g2) =
-        parStep (compositeStep f1 g1) (dimapStep f2 id g2)
+    forall f1 f2 g1 g2. compositeProc (parProc f1 (arrProc f2)) (parProc g1 g2) =
+        parProc (compositeProc f1 g1) (dimapProc f2 id g2)
 "ProcessA: par/***arr"
-    forall f1 f2 g1 g2 h. compositeStep (parStep f1 f2) (compositeStep (parStep (arrStep g1) g2) h) =
-        compositeStep (parStep (dimapStep id g1 f1) (compositeStep f2 g2)) h
+    forall f1 f2 g1 g2 h. compositeProc (parProc f1 f2) (compositeProc (parProc (arrProc g1) g2) h) =
+        compositeProc (parProc (dimapProc id g1 f1) (compositeProc f2 g2)) h
 "ProcessA: par/***arr-2"
-    forall f1 f2 g1 g2. compositeStep (parStep f1 f2) (parStep (arrStep g1) g2) =
-        parStep (dimapStep id g1 f1) (compositeStep f2 g2)
+    forall f1 f2 g1 g2. compositeProc (parProc f1 f2) (parProc (arrProc g1) g2) =
+        parProc (dimapProc id g1 f1) (compositeProc f2 g2)
 
 "ProcessA: first/par"
-    forall f1 g1 g2 h. compositeStep (parStep f1 idStep) (compositeStep (parStep g1 g2) h) =
-        compositeStep (parStep (compositeStep f1 g1) g2) h
+    forall f1 g1 g2 h. compositeProc (parProc f1 idProc) (compositeProc (parProc g1 g2) h) =
+        compositeProc (parProc (compositeProc f1 g1) g2) h
 "ProcessA: first/par-2"
-    forall f1 g1 g2. compositeStep (parStep f1 idStep) (parStep g1 g2) =
-        parStep (compositeStep f1 g1) g2
+    forall f1 g1 g2. compositeProc (parProc f1 idProc) (parProc g1 g2) =
+        parProc (compositeProc f1 g1) g2
 "ProcessA: par/second"
-    forall f1 f2 g2 h. compositeStep (parStep f1 f2) (compositeStep (parStep idStep g2) h) =
-        compositeStep (parStep f1 (compositeStep f2 g2)) h
+    forall f1 f2 g2 h. compositeProc (parProc f1 f2) (compositeProc (parProc idProc g2) h) =
+        compositeProc (parProc f1 (compositeProc f2 g2)) h
 "ProcessA: par/second-2"
-    forall f1 f2 g2. compositeStep (parStep f1 f2) (parStep idStep g2) =
-        parStep f1 (compositeStep f2 g2)
+    forall f1 f2 g2. compositeProc (parProc f1 f2) (parProc idProc g2) =
+        parProc f1 (compositeProc f2 g2)
 
 "ProcessA: arr/arr"
-    forall f g h. compositeStep (arrStep f) (compositeStep (arrStep g) h) =
-        compositeStep (arrStep (g . f)) h
+    forall f g h. compositeProc (arrProc f) (compositeProc (arrProc g) h) =
+        compositeProc (arrProc (g . f)) h
 "ProcessA: arr/arr-2"
-    forall f g. compositeStep (arrStep f) (arrStep g) = arrStep (g . f)
+    forall f g. compositeProc (arrProc f) (arrProc g) = arrProc (g . f)
 "ProcessA: arr/*" [1]
-    forall f g. compositeStep (arrStep f) g = dimapStep f id g
+    forall f g. compositeProc (arrProc f) g = dimapProc f id g
 "ProcessA: */arr" [1]
-    forall f g. compositeStep f (arrStep g) = dimapStep id g f
+    forall f g. compositeProc f (arrProc g) = dimapProc id g f
 "ProcessA: arr***arr" [0]
-    forall f g. parStep (arrStep f) (arrStep g) = arrStep (f *** g)
+    forall f g. parProc (arrProc f) (arrProc g) = arrProc (f *** g)
   #-}
 
-instance
-    ArrowApply a => ArrowChoice (ProcessA a)
-  where
-    left pa@(ProcessA a) = ProcessA $ proc (ph, eth) -> go ph eth -<< ()
-      where
-        go ph (Left x) = proc _ -> 
-          do
-            (ph', y, pa') <- a -< (ph, x)
-            returnA -< (ph', Left y, left pa')
-        go ph (Right d) = proc _ -> 
-            returnA -< (ph `mappend` Suspend, Right d, left pa)
 
 instance
-    (ArrowApply a, ArrowLoop a) => ArrowLoop (ProcessA a)
+    ArrowApply a => ArrowChoice (ProcessA a)
   where
-    loop pa = ProcessA $ proc (ph, x) ->
-      do
-        (_, d) <- loop suspended -< x
-        (ph', (y, _), pa') <- step pa -< (ph, (x, d))
-        returnA -< (ph', y, loop pa')
+    left pa0 = makePA
+        (proc eth -> sweep' pa0 eth -<< ())
+        (left $ suspend pa0)
       where
-        suspended = proc (x, d) ->
+        sweep' pa (Left x) = proc () ->
           do
-            (_, (y, d'), _) <- step pa -< (Suspend, (x, d))
-            returnA -< ((y, d'), d')
-
-
-instance
-    (ArrowApply a, ArrowReader r a) => 
-    ArrowReader r (ProcessA a)
-  where
-    readState = ProcessA $ proc (ph, dm) ->
-      do
-        r <- readState -< dm
-        returnA -< (ph `mappend` Suspend, r, readState)
-
-    newReader = fitEx nr
-      where
-        nr f = proc (p, (x, r)) -> newReader f -< ((p, x), r)
+            (my, pa') <- step pa -< x
+            returnA -< (Left <$> my, left pa')
+        sweep' pa (Right d) = proc () ->
+            returnA -< (weakly (Right d), left pa)
 
 instance
-    (ArrowApply a, ArrowApply a', ArrowAddReader r a a') =>
-    ArrowAddReader r (ProcessA a) (ProcessA a')
+    ArrowApply a => ArrowLoop (ProcessA a)
   where
-    liftReader pa = ProcessA $ proc (ph, x) ->
-      do
-        (ph', y, pa') <- (| liftReader (step pa -< (ph, x)) |)
-        returnA -< (ph', y, liftReader pa')
-
-    elimReader pra = 
-        ProcessA $ arr pre >>> elimReader (step pra) >>> arr post
+    loop pa =
+        makePA 
+            (proc x ->
+              do
+                (hyd, pa') <- step pa -< (x, loopSusD x)
+                returnA -< (fst <$> hyd, loop pa'))
+            (loop $ suspend pa)
       where
-        pre (ph, (x, r)) = ((ph, x), r)
-        post (ph, x, pra') = (ph, x, elimReader pra')
-
+        loopSusD = loop (suspend pa >>> \(_, d) -> (d, d))
 
-    
-data Event a = Event a | NoEvent | End deriving (Eq, Show)
+-- | Discrete events on a time line.
+-- Created and consumed by various transducers.
+data Event a = Event a | NoEvent | End
 
 
 instance 
@@ -400,7 +439,7 @@
 
 
 -- | Signals that can be absent(`NoEvent`) or end.
--- For composite structure, `collapse` can be defined as monoidal sum of all member occasionals.
+-- For composite structure, `collapse` can be defined as monoid sum of all member occasionals.
 class 
     Occasional' a
   where
@@ -437,18 +476,27 @@
     end = End
 
 
-
--- TODO: テスト
 condEvent :: Bool -> Event a -> Event a
 condEvent _ End = End
 condEvent True ev = ev
 condEvent False _ = NoEvent
 
--- TODO: テスト
 filterEvent :: (a -> Bool) -> Event a -> Event a
 filterEvent cond ev@(Event x) = condEvent (cond x) ev
 filterEvent _ ev = ev
 
+filterJust :: Event (Maybe a) -> Event a
+filterJust (Event (Just x)) = Event x
+filterJust (Event Nothing) = NoEvent
+filterJust NoEvent = NoEvent
+filterJust End = End
+
+filterLeft :: Event (Either a b) -> Event a
+filterLeft = filterJust . fmap (either Just (const Nothing))
+
+filterRight :: Event (Either a b) -> Event b
+filterRight = filterJust . fmap (either (const Nothing) Just)
+
 -- | Alias of "arr . fmap"
 --
 -- While "ProcessA a (Event b) (Event c)" means a transducer from b to c,
@@ -481,7 +529,7 @@
     (ArrowApply a, Occasional' b, Occasional c) => ProcessA a b c
 muted = proc x ->
   do
-    ed <- repeatedly $ await `catchP` yield () -< collapse x
+    ed <- construct (forever await `catchP` yield ()) -< collapse x
     rSwitch (arr $ const noEvent) -< ((), stopped <$ ed)
 
 
@@ -496,32 +544,60 @@
   fmap g (YieldPF x r) = YieldPF x (g r)
   fmap _ StopPF = StopPF
 
-
-type PlanT i o m a = F.FT (PlanF i o) m a
+newtype PlanT i o m a =
+    PlanT { freePlanT :: F.FT (PlanF i o) m a }
+  deriving
+    (Functor, Applicative, Monad, MonadTrans,
+     Alternative)
+    -- , MonadError, MonadReader, MonadCatch, MonadThrow, MonadIO, MonadCont
 type Plan i o a = forall m. Monad m => PlanT i o m a
 
+instance
+    MonadReader r m => MonadReader r (PlanT i o m)
+  where
+    ask = PlanT ask
+    local f (PlanT pl) = PlanT $ local f pl
 
+instance
+    MonadWriter w m => MonadWriter w (PlanT i o m)
+  where
+    tell = PlanT . tell
+    listen = PlanT . listen . freePlanT
+    pass = PlanT . pass . freePlanT
+
+instance
+    MonadState s m => MonadState s (PlanT i o m)
+  where
+    get = PlanT get
+    put = PlanT . put
+
+instance
+    (Monad m, Alternative m) => MonadPlus (PlanT i o m)
+  where
+    mzero = stop
+    mplus = catchP
+
 yield :: o -> Plan i o ()
-yield x = F.liftF $ YieldPF x ()
+yield x = PlanT . F.liftF $ YieldPF x ()
 
 await :: Plan i o i
-await = F.FT $ \pure free -> free id (AwaitPF pure (free pure StopPF))
+await = PlanT $ F.FT $ \pr free -> free id (AwaitPF pr (free pr StopPF))
 
 stop :: Plan i o a
-stop = F.liftF $ StopPF
+stop = PlanT $ F.liftF $ StopPF
 
 
 catchP:: Monad m =>
     PlanT i o m a -> PlanT i o m a -> PlanT i o m a
 
-catchP pl cont0 = 
-    F.FT $ \pure free ->
+catchP (PlanT pl) cont0 = 
+    PlanT $ F.FT $ \pr free ->
         F.runFT
             pl
-            (pure' pure)
-            (free' cont0 pure free)
+            (pr' pr)
+            (free' cont0 pr free)
   where
-    pure' pure = pure
+    pr' pr = pr
 
     free' ::
         Monad m =>
@@ -531,11 +607,11 @@
         (y -> m r) ->
         (PlanF i o y) ->
         m r
-    free' cont pure free _ StopPF =
-        F.runFT cont pure free
-    free' cont pure free r (AwaitPF f ff) =
+    free' (PlanT cont) pr free _ StopPF =
+        F.runFT cont pr free
+    free' (PlanT cont) pr free r (AwaitPF f ff) =
         free
-            (either (\_ -> F.runFT cont pure free) r)
+            (either (\_ -> F.runFT cont pr free) r)
             (AwaitPF (Right . f) (Left ff))
     free' _ _ free r pf =
         free r pf
@@ -543,59 +619,69 @@
 
 
 
-constructT :: (Monad m, ArrowApply a) => 
-              (forall b. m b -> a () b) ->
-              PlanT i o m r -> 
-              ProcessA a (Event i) (Event o)
+constructT ::
+    (Monad m, ArrowApply a) => 
+    (forall b. m b -> a () b) ->
+    PlanT i o m r -> 
+    ProcessA a (Event i) (Event o)
+constructT = constructT'
 
-constructT fit0 pl0 = ProcessA $ stepOf fit0 $ F.runFT pl0 pure (free fit0)
+
+constructT' ::
+    forall a m i o r.
+    (Monad m, ArrowApply a) => 
+    (forall b. m b -> a () b) ->
+    PlanT i o m r -> 
+    ProcessA a (Event i) (Event o)
+constructT' fit0 (PlanT pl0) = prependProc $ F.runFT pl0 pr free
   where
-    stepOf fit' ma = proc arg ->
-      do
-        (evy, stp) <- fit' ma -< ()
-        prependStep evy stp -<< arg
-      
-    prependStep (Event y) stp = arr $ \(ph, _) -> 
-        case ph of
-          Suspend -> 
-              (Suspend, NoEvent, ProcessA $ prependStep (Event y) stp)
-          _ -> 
-              (Feed, Event y, ProcessA stp)
-    prependStep End _ = step stopped
-    prependStep NoEvent stp = stp
+    fit' :: (b -> m c) -> a b c
+    fit' fmy = proc x -> fit0 (fmy x) -<< ()
 
-    stepOfAw fit' fma = proc arg@(ph, _) ->
-      do
-        (evy, stp) <- fit' $ go arg -<< ()
-        let ph' = case evy of {NoEvent -> Suspend; _ -> Feed}
-        returnA -< (ph `mappend` ph', evy, ProcessA stp)
-      where
-        go (Feed, evx) = fma evx
-        go (Sweep, End) = fma End
-        go _ = return (NoEvent, stepOfAw fit' fma)
+    prependProc ::
+        m (Event o, ProcessA a (Event i) (Event o)) ->
+        ProcessA a (Event i) (Event o)
+    prependProc mr = ProcessA {
+        feed = proc ex -> do { r <- fit0 mr -< (); prependFeed r -<< ex} ,
+        sweep = proc ex -> do { r <- fit0 mr -< (); prependSweep r -<< ex},
+        suspend = const NoEvent
+      }
 
-    pure _ =
-        return $ (End, step stopped)
+    prependFeed (Event x, pa) = arr $ const (Event x, pa)
+    prependFeed (NoEvent, pa) = feed pa
+    prependFeed (End, _) = arr $ const (End, stopped)
+  
+    prependSweep (Event x, pa) = arr $ const (Just (Event x), pa)
+    prependSweep (NoEvent, pa) = sweep pa
+    prependSweep (End, _) = arr $ const (Just End, stopped)
+  
+    pr _ = return (End, stopped)
 
     free ::
-        (ArrowApply a, Monad m) =>
-        (forall t. m t -> a () t) ->
-        (x -> m (Event o, StepType a (Event i) (Event o)))
-        -> PlanF i o x -> m (Event o, StepType a (Event i) (Event o))
-    free fit' r pl@(AwaitPF f ff) =
-      do
-        return $ (NoEvent, stepOfAw fit' fma)
+        (x -> m (Event o, ProcessA a (Event i) (Event o)))->
+        PlanF i o x ->
+        m (Event o, ProcessA a (Event i) (Event o))
+    free r (YieldPF y cont) =
+        return (Event y, prependProc (r cont))
+    free r pl@(AwaitPF f ff) =
+        return (NoEvent, awaitProc fma)
       where
         fma (Event x) = r (f x)
-        fma NoEvent = free fit' r pl
+        fma NoEvent = free r pl
         fma End = r ff
-
-    free fit' r (YieldPF y fc) =
-        return $ (Event y, stepOf fit' (r fc))
+    free _ StopPF =
+        return (End, stopped)
 
-    free _ _ StopPF =
-        return $ (End, step stopped)
+    awaitProc fma = ProcessA {
+        feed = fit' fma,
+        sweep = fit' fma >>> first eToM,
+        suspend = const NoEvent
+      }
 
+    eToM :: a (Event b) (Maybe (Event b))
+    eToM = arr eToMpure
+    eToMpure NoEvent = Nothing
+    eToMpure e = Just e
 
 
 repeatedlyT :: (Monad m, ArrowApply a) => 
@@ -621,27 +707,7 @@
 --
 -- Switches
 --
-evMaybePh :: b -> (a->b) -> (Phase, Event a) -> b
-evMaybePh _ f (Feed, Event x) = f x
-evMaybePh _ f (Sweep, Event x) = f x
-evMaybePh d _ _ = d
-
-
-{-
-type KSwitchLike a b c t =
-    ProcessA a b c ->
-    ProcessA a (b, ) (Event t) ->
-    (ProcessA a b c -> t -> ProcessA a b c) ->
-    ProcessA a b c
-
 switchCore ::
-    ArrowApply a =>
-    KSwitchLike a b c t ->
-    ProcessA a b (c, Event t) -> 
-    (t -> ProcessA a b c) ->
-    ProcessA a b c
--}
-switchCore ::
     (Arrow cat, Arrow a2, Arrow cat1, Occasional t3) =>
     (t4
      -> a2 (t5, (t6, c1)) c1
@@ -675,7 +741,6 @@
 rSwitch :: 
     ArrowApply a => ProcessA a b c -> 
     ProcessA a (b, Event (ProcessA a b c)) c
-
 rSwitch p = rSwitch' (p *** Cat.id) >>> arr fst
   where
     rSwitch' pid = kSwitch pid test $ \_ p' -> rSwitch'' (p' *** Cat.id)
@@ -691,28 +756,24 @@
   where
     drSwitch' pid = dSwitch pid $ \p' -> drSwitch' (p' *** Cat.id)
 
+
 kSwitch ::
     ArrowApply a => 
     ProcessA a b c ->
     ProcessA a (b, c) (Event t) ->
     (ProcessA a b c -> t -> ProcessA a b c) ->
     ProcessA a b c
-
-kSwitch sf test k = ProcessA $ proc (ph, x) ->
-  do
-    (ph', y, sf') <- step sf -< (ph, x)
-    (phT, evt, test') <- step test -< (ph', (x, y))
-
-    let
-        nextA t = k sf' t
-        nextB = kSwitch sf' test' k
-
-    evMaybePh 
-        (arr $ const (phT, y, nextB)) 
-        (step . nextA)
-        (phT, evt)
-            -<< (phT, x)
-
+kSwitch sf test k = makePA
+    (proc x ->
+      do
+        (hy, sf') <- step sf -< x
+        (hevt, test') <- step' test -< (x,) <$> hy
+        (case (helperToMaybe hevt)
+          of
+            Just (Event t) -> step (k sf' t)
+            _ -> arr $ const (hy, kSwitch sf' test' k))
+                -<< x)
+    (suspend sf)
 
 dkSwitch ::
     ArrowApply a => 
@@ -720,67 +781,84 @@
     ProcessA a (b, c) (Event t) ->
     (ProcessA a b c -> t -> ProcessA a b c) ->
     ProcessA a b c
-
-dkSwitch sf test k = ProcessA $ proc (ph, x) ->
-  do
-    (ph', y, sf') <- step sf -< (ph, x)
-    (phT, evt, test') <- step test -< (ph', (x, y))
-    
-    let
-        nextA t = k sf' t
-        nextB = dkSwitch sf' test' k
-
-    returnA -< (phT, y, evMaybePh nextB nextA (ph, evt))
-
-
+dkSwitch sf test k = makePA
+    (proc x ->
+      do
+        (hy, sf') <- step sf -< x
+        (hevt, test') <- step' test -< (x,) <$> hy
+        (case (helperToMaybe hevt)
+          of
+            Just (Event t) -> arr $ const (hy, k sf' t)
+            _ -> arr $ const (hy, dkSwitch sf' test' k))
+                -<< x)
+    (suspend sf)
+  
 broadcast :: 
     Functor col =>
     b -> col sf -> col (b, sf)
-
 broadcast x sfs = fmap (\sf -> (x, sf)) sfs
 
-
 par ::
     (ArrowApply a, Tv.Traversable col) =>
     (forall sf. (b -> col sf -> col (ext, sf))) ->
     col (ProcessA a ext c) ->
     ProcessA a b (col c)
-
-par r sfs = ProcessA $ parCore r sfs >>> arr cont
-  where
-    cont (ph, ys, sfs') = (ph, ys, par r sfs')
+par r sfs =
+    makePA
+        (parCore r sfs >>> second (arr (par r)))
+        (suspendAll r sfs)
 
 parB ::
     (ArrowApply a, Tv.Traversable col) =>
     col (ProcessA a b c) ->
     ProcessA a b (col c)
-
 parB = par broadcast
 
-parCore ::
+suspendAll :: 
     (ArrowApply a, Tv.Traversable col) =>
     (forall sf. (b -> col sf -> col (ext, sf))) ->
     col (ProcessA a ext c) ->
-    a (Phase, b) (Phase, col c, col (ProcessA a ext c))
+    b -> col c
+suspendAll r sfs = (sus <$>) . (r `flip` sfs)
+  where
+    sus (ext, sf) = suspend sf ext
+     
+traverseResult ::
+    forall h col c.
+    (Tv.Traversable col, ProcessHelper h) =>
+    col (h c, c) -> h (col c)
+traverseResult zs =
+    let
+        pr :: (h c, c) -> StateT Bool h c
+        pr (hx, d) =
+          do
+            let mx = helperToMaybe hx
+            if isJust mx then put True else return ()
+            return (fromMaybe d mx)
+        hxs = runStateT (Tv.sequence (pr <$> zs)) False
+        exist = fromMaybe False $ helperToMaybe (snd <$> hxs)
+        result = fst <$> hxs
+      in
+        if exist then result else join (weakly result)
+     
+parCore ::
+    (ArrowApply a, Tv.Traversable col, ProcessHelper h) =>
+    (forall sf. (b -> col sf -> col (ext, sf))) ->
+    col (ProcessA a ext c) ->
+    a b (h (col c), col (ProcessA a ext c))
 
-parCore r sfs = proc (ph, x) ->
+parCore r sfs = proc x ->
   do
     let input = r x sfs
-
-    ret <- unwrapArrow (Tv.sequenceA (fmap (WrapArrow . appPh) input)) -<< ph
-
-    let ph' = Fd.foldMap getPh ret
-        zs = fmap getZ ret
-        sfs' = fmap getSf ret
-
-    returnA -< (ph', zs, sfs')
-
+    ret <- unwrapArrow (Tv.sequenceA (fmap (WrapArrow . app') input)) -<< ()
+    let zs = traverseResult $ fmap fst ret
+        sfs' = fmap snd ret
+    returnA -< (zs, sfs')
   where
-    appPh (y, sf) = proc ph -> step sf -< (ph, y)
-
-    getPh (ph, _, _) = ph
-    getZ (_, z, _) = z
-    getSf (_, _, sf) = sf
+    app' (y, sf) = proc () ->
+      do
+        (hz, sf') <- step sf -< y
+        returnA -< ((hz, suspend sf' y), sf')
 
 
 pSwitch ::
@@ -790,48 +868,50 @@
     ProcessA a (b, col c) (Event mng) ->
     (col (ProcessA a ext c) -> mng -> ProcessA a b (col c)) ->
     ProcessA a b (col c)
-
-pSwitch r sfs test k = ProcessA $ proc (ph, x) ->
-  do
-    (ph', zs, sfs') <- parCore r sfs -<< (ph, x)
-    (phT, evt, test') <- step test -< (ph', (x, zs))
-
-    evMaybePh
-        (arr $ const (phT, zs, pSwitch r sfs' test' k))
-        (step . (k sfs') )
-        (phT, evt)
-            -<< (ph, x)
-
+pSwitch r sfs test k = makePA
+    (proc x ->
+      do
+        (hzs, sfs') <- parCore r sfs -<< x
+        (hevt, test') <- step' test -< (x,) <$> hzs
+        (case helperToMaybe hevt
+          of
+            Just (Event t) -> (step (k sfs' t))
+            _ -> arr $ const (hzs, pSwitch r sfs' test' k))
+                -<< x)
+    (suspendAll r sfs)
+  
 pSwitchB ::
     (ArrowApply a, Tv.Traversable col) =>
     col (ProcessA a b c) ->
     ProcessA a (b, col c) (Event mng) ->
     (col (ProcessA a b c) -> mng -> ProcessA a b (col c)) ->
     ProcessA a b (col c)
-
 pSwitchB = pSwitch broadcast
 
 
+
 rpSwitch ::
     (ArrowApply a, Tv.Traversable col) =>
     (forall sf. (b -> col sf -> col (ext, sf))) ->
     col (ProcessA a ext c) ->
-    ProcessA a (b, Event (col (ProcessA a ext c) -> col (ProcessA a ext c)))
+    ProcessA a
+        (b, Event (col (ProcessA a ext c) -> col (ProcessA a ext c)))
         (col c)
-
-rpSwitch r sfs = ProcessA $ proc (ph, (x, evCont)) ->
-  do
-    let sfsNew = evMaybePh sfs ($sfs) (ph, evCont)
-    (ph', ws, sfs') <- parCore r sfsNew -<< (ph, x)
-    returnA -< (ph' `mappend` Suspend, ws, rpSwitch r sfs')
-
+rpSwitch r sfs = makePA
+    (proc (x, evCont) ->
+      do
+        let sfsNew = case evCont of {Event f -> f sfs; _ -> sfs}
+        (hzs, sfs') <- parCore r sfsNew -<< x
+        returnA -< (hzs, rpSwitch r sfs'))
+    (fst >>> suspendAll r sfs)
+    
 
 rpSwitchB ::
     (ArrowApply a, Tv.Traversable col) =>
     col (ProcessA a b c) ->
-    ProcessA a (b, Event (col (ProcessA a b c) -> col (ProcessA a b c)))
+    ProcessA a
+        (b, Event (col (ProcessA a b c) -> col (ProcessA a b c)))
         (col c)
-
 rpSwitchB = rpSwitch broadcast
 
 -- `dpSwitch` and `drpSwitch` are not implemented.
@@ -840,25 +920,6 @@
 --
 -- Unsafe primitives
 --
-
--- | Repeatedly call `p`.
---
--- How many times `p` is called is indefinite.
--- So `p` must satisfy the equation below;
---
--- @p &&& p === p >>> (id &&& id)@
-unsafeSteady ::
-    ArrowApply a =>
-    a b c ->
-    ProcessA a b c
-unsafeSteady f =
-    fitEx
-        (\id' ->
-            arr (\(p, x)->((p, ()), x)) >>>
-            (id' *** f) >>>
-            arr (\((q, ()), y)->(q, y)))
-        Cat.id
-      
     
 -- | Repeatedly call `p`.
 --    
@@ -877,16 +938,11 @@
 unsafeExhaust p =
     go >>> fork
   where
-    go = ProcessA $ proc (ph, x) -> handle ph -<< x
-    
-    handle Suspend =
-        arr $ const (Suspend, NoEvent, go)
-
-    handle ph = proc x ->
-      do
-        ys <- p -< x
-        let ph' = if nullFd ys then Suspend else Feed
-        returnA -< (ph `mappend` ph', Event ys, go)
+    go = ProcessA {
+        feed = p >>> arr (\y -> (Event y, go)),
+        sweep = p >>> arr (\y -> (if nullFd y then Nothing else Just (Event y), go)),
+        suspend = const NoEvent
+      }
 
     fork = repeatedly $ await >>= Fd.mapM_ yield
 
@@ -974,10 +1030,10 @@
         else
             return False
 
-feed :: 
+feedR :: 
     Monad m => 
     i -> RM a (Event i) o m Bool
-feed x = feed_ (Event x) NoEvent
+feedR x = feed_ (Event x) NoEvent
 
 
 {-
@@ -993,29 +1049,42 @@
 freeze = gets freezeRI
     
 
-sweep :: 
+sweepR :: 
     Monad m =>
     RM a i o m o
-sweep =
+sweepR =
   do
     pa <- freeze
-    fit0 <- gets getFitRI
     ph <- gets getPhaseRI
-    x <- if ph == Feed
-        then gets getInputRI
-        else gets getPaddingRI
+    ri <- get
+    case ph of
+      Feed ->
+        do
+            fit0 <- gets getFitRI
+            x <- gets getInputRI
+            (y, pa') <- lift $ fit0 (feed pa) x
+            put $ ri {
+                freezeRI = pa',
+                getPhaseRI = Sweep
+              }
+            return y
+      Sweep ->  
+        do
+            fit0 <- gets getFitRI
+            x <- gets getPaddingRI
+            (my, pa') <- lift $ fit0 (sweep pa) x
+            put $ ri {
+                freezeRI = pa',
+                getPhaseRI = if isJust my then Sweep else Suspend
+              }
+            return $ fromMaybe (suspend pa x) my
+      Suspend ->
+        do
+            x <- gets getPaddingRI
+            return $ suspend pa x
     
-    (ph', y, pa') <- lift $ fit0 (step pa) (ph, x)
     
-    ri <- get
-    put $ ri {
-        freezeRI = 
-            pa',
-        getPhaseRI = 
-            if ph' == Feed then Sweep else ph'
-      }
-
-    return y
+    
 
 
 sweepAll :: 
@@ -1026,7 +1095,7 @@
         while_ 
             ((not . (== Suspend)) `liftM` lift (gets getPhaseRI)) $
           do
-            evx <- lift sweep
+            evx <- lift sweepR
             case evx
               of
                 Event x ->
@@ -1065,12 +1134,12 @@
   where
     feedSweep x cont =
       do
-        _ <- lift $ feed x
+        _ <- lift $ feedR x
         ((), wer) <- listen $ sweepAll outpre
         if getContWE wer then cont else return ()
-      
 
 
+
 newtype Builder a = Builder {
     unBuilder :: forall b. (a -> b -> b) -> b -> b
   }
@@ -1103,9 +1172,14 @@
 data ExecInfo fa =
     ExecInfo
       {
-        yields :: fa, -- [a] or Maybe a
-        hasConsumed :: Bool,
-        hasStopped :: Bool
+        yields :: fa, -- ^ Values yielded while the step.
+        hasConsumed :: Bool, -- ^ True if the input value is consumed.
+            --
+            -- False if the machine has stopped unless consuming the input.
+            --
+            -- Or in the case of `stepYield`, this field become false when
+            -- the machine produces a value unless consuming the input.
+        hasStopped :: Bool -- ^ True if the machine has stopped at the end of the step.
       }
     deriving (Eq, Show)
 
@@ -1117,18 +1191,17 @@
         ExecInfo (y1 <|> y2) (c1 || c2) (s1 || s2)
 
 
--- | Execute until an input consumed and the machine suspended.
+-- | Execute until an input consumed and the machine suspends.
 stepRun :: 
     ArrowApply a =>
     ProcessA a (Event b) (Event c) ->
     a b (ExecInfo [c], ProcessA a (Event b) (Event c))
-
 stepRun pa0 = unArrowMonad $ \x ->
   do
     (pa, wer)  <- runRM arrowMonad pa0 $ runWriterT $ 
       do
         sweepAll singleton
-        _ <- lift $ feed x
+        _ <- lift $ feedR x
         sweepAll singleton
         lift $ freeze
     return $ (retval wer, pa)
@@ -1147,7 +1220,6 @@
     ArrowApply a =>
     ProcessA a (Event b) (Event c) ->
     a b (ExecInfo (Maybe c), ProcessA a (Event b) (Event c))
-
 stepYield pa0 = unArrowMonad $ \x -> runRM arrowMonad pa0 $ evalStateT `flip` mempty $
   do
     go x
@@ -1158,10 +1230,10 @@
   where 
     go x =
       do
-        csmd <- lift $ feed x
+        csmd <- lift $ feedR x
         modify $ \ri -> ri { hasConsumed = csmd }
                              
-        evo <- lift sweep
+        evo <- lift sweepR
         
         case evo
           of
@@ -1176,5 +1248,4 @@
 
             End ->
                 modify $ \ri -> ri { hasStopped = True }
-
 
diff --git a/src/Control/Arrow/Machine/Utils.hs b/src/Control/Arrow/Machine/Utils.hs
--- a/src/Control/Arrow/Machine/Utils.hs
+++ b/src/Control/Arrow/Machine/Utils.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE Arrows #-}
 {-# LANGUAGE RankNTypes #-}
@@ -5,6 +6,12 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE Safe #-}
+#else
+{-# LANGUAGE Trustworthy #-}
+#endif
+
 module
     Control.Arrow.Machine.Utils
       (
@@ -14,8 +21,6 @@
         accum,
         dAccum,
         edge,
-        passRecent,
-        withRecent,
 
         -- * Switches
         -- | Switches inspired by Yampa library.
@@ -32,10 +37,6 @@
         rpSwitch,
         rpSwitchB,
 
-        -- * State arrow
-        peekState,
-        encloseState,
-
         -- * Other utility arrows
         tee,
         gather,
@@ -49,22 +50,22 @@
         parB,
         now,
         onEnd,
-        cycleDelay
+    
+        -- * Transformer
+        readerProc
        )
 where
 
 import Prelude hiding (filter)
 
-import Data.Maybe (fromMaybe)
 import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Foldable as Fd
 import qualified Control.Category as Cat
 import Control.Monad.Trans
 import Control.Monad.State
 import Control.Arrow
-import Control.Arrow.Operations (ArrowState(..))
-import Control.Arrow.Transformer.State (ArrowAddState(..), StateArrow())
 import Control.Applicative
+import Control.Arrow.Transformer.Reader (ArrowAddReader(..))
 
 import Control.Arrow.Machine.ArrowUtil
 import Control.Arrow.Machine.Types
@@ -95,85 +96,21 @@
     ArrowApply a => b -> ProcessA a (Event (b->b)) b
 dAccum x = dSwitch (pure x &&& arr (($x)<$>)) dAccum
 
+
 edge :: 
     (ArrowApply a, Eq b) =>
     ProcessA a b (Event b)
-
-edge = encloseState (unsafeExhaust impl) Nothing
-  where
-    impl ::
-        (ArrowApply a, Eq b) =>
-        StateArrow (Maybe b) a b (Maybe b)
-    impl = proc x ->
-      do
-        mprv <- fetch -< ()
-        store -< Just x
-        returnA -<
-            case mprv
-              of
-                Just prv -> if prv == x then Nothing else Just x
-                Nothing -> Just x
-
-{-# DEPRECATED passRecent, withRecent "Use `hold` instead" #-}
-infixr 9 `passRecent`
-
-passRecent :: 
-    (ArrowApply a, Occasional o) =>
-    ProcessA a (AS e) (Event b) ->
-    ProcessA a (e, AS b) o ->
-    ProcessA a (AS e) o
-
-passRecent af ag = proc ase ->
-  do
-    evx <- af -< ase
-    mvx <- hold Nothing -< Just <$> evx
-    case mvx of
-      Just x -> ag -< (fromAS ase, toAS x)
-      _ -> returnA -< noEvent
-
-withRecent :: 
-    (ArrowApply a, Occasional o) =>
-    ProcessA a (e, AS b) o ->
-    ProcessA a (e, AS (Event b)) o
-withRecent af = proc (e, asevx) ->
+edge = proc x ->
   do
-    mvx <- hold Nothing -< Just <$> fromAS asevx
-    case mvx of
-      Just x -> af -< (e, toAS x)
-      _ -> returnA -< noEvent
-
-
-
-
-
-
---
--- State arrow
---
-peekState ::
-    (ArrowApply a, ArrowState s a) =>
-    ProcessA a e s
-peekState = unsafeSteady fetch
-
--- Should be exported?
-exposeState ::
-    (ArrowApply a, ArrowApply a', ArrowAddState s a a') =>
-    ProcessA a b c ->
-    ProcessA a' (b, s) (c, s)
-exposeState = fitEx es
+    rec
+        ev <- unsafeExhaust (arr judge) -< (prv, x)
+        prv <- dHold Nothing -< Just x <$ ev
+    returnA -< ev
   where
-    es f = proc (p, (x, s)) ->
-      do
-        ((q, y), s') <- elimState f -< ((p, x), s)
-        returnA -< (q, (y, s'))
+    judge (prv, x) = if prv == Just x then Nothing else Just x
 
-encloseState ::
-    (ArrowApply a, ArrowApply a', ArrowAddState s a a') =>
-    ProcessA a b c ->
-    s ->
-    ProcessA a' b c
-encloseState pa s = loop' s (exposeState pa)
 
+
 --
 -- other utility arrow
 
@@ -294,30 +231,14 @@
   where
     go = repeatedly $
         await `catchP` (yield () >> stop)
-    
--- |Observe a previous value of a signal.
--- Tipically used with rec statement.
 
-{-# DEPRECATED cycleDelay "Simply use `dHold` or `dAccum`" #-}
-cycleDelay ::
-    ArrowApply a => ProcessA a b b
-cycleDelay =
-    encloseState impl (Nothing, Nothing)
+-- | Run reader of base arrow.
+readerProc ::
+    (ArrowApply a, ArrowApply a', ArrowAddReader r a a') =>
+    ProcessA a b c ->
+    ProcessA a' (b, r) c
+readerProc pa = arr swap >>> fitW snd (\ar -> arr swap >>> elimReader ar) pa
   where
-    impl :: ArrowApply a => ProcessA (StateArrow (Maybe b, Maybe b) a) b b
-    impl = proc x ->
-      do
-        -- Load stored value when backtracking reaches here.
-        (_, stored) <- peekState -< ()
-        unsafeExhaust (app >>> arr (const Nothing)) -< appStore stored
-
-        -- Repeat current value.
-        (current, _) <- peekState -< ()
-        let x0 = fromMaybe x current
-        unsafeSteady store -< (Just x0, Just x)
-        returnA -< x0
-
-    appStore (Just x) = (proc _ -> store -< (Just x, Nothing), ())
-    appStore _ = (Cat.id, ())
-    
+    swap :: (a, b) -> (b, a)
+    swap ~(a, b) = (b, a)
     
diff --git a/test/LoopUtil.hs b/test/LoopUtil.hs
--- a/test/LoopUtil.hs
+++ b/test/LoopUtil.hs
@@ -14,6 +14,10 @@
 import Control.Monad.Trans (liftIO)
 import qualified Control.Arrow.Machine.Misc.Pump as Pump
 
+import Data.Monoid (Endo(Endo), mappend, appEndo)
+
+newtype Duct a = Duct (Endo [a])
+
 doubler = arr (fmap $ \x -> [x, x]) >>> P.fork
 
 loopUtil =
@@ -35,22 +39,6 @@
             ret <- liftIO $ runKleisli (P.run pa) [1, 2, 3]
             ret `shouldBe` [0, 1+1, 1+1+2+2]
   
-    describe "cycleDelay" $
-      do
-        it "can refer a recent value at downstream." $
-          do
-            let 
-                pa :: ProcessA (Kleisli IO) (Event Int) (Event Int)
-                pa = proc evx ->
-                  do
-                    rec
-                        y <- P.cycleDelay -< r2
-                        anytime (Kleisli putStr) -< "" <$ evx -- side effect
-                        evx2 <- doubler -< evx
-                        r2 <- P.accum 0 -< (+) <$> evx2
-                    returnA -< y <$ evx
-            ret <- liftIO $ runKleisli (P.run pa) [1, 2, 3]
-            ret `shouldBe` [0, 1+1, 1+1+2+2]
     describe "Pump" $
       do
         it "pumps up an event stream." $
@@ -60,12 +48,13 @@
                 pa = proc evx ->
                   do
                     rec
-                         evOut <- Pump.outlet -< (dct, () <$ evx)
-                         anytime (Kleisli putStr) -< "" <$ evx -- side effect
-                         so <- doubler -< evx
-                         dct <- Pump.intake -< (so, () <$ evx)
+                        evOut <- Pump.outlet -< (dct, () <$ evx)
+                        anytime (Kleisli putStr) -< "" <$ evx -- side effect
+                        so <- doubler -< evx
+                        dct <- Pump.intake -< (so, () <$ evx)
                     returnA -< evOut
 
             ret <- liftIO $ runKleisli (P.run pa) [4, 5, 6]
             ret `shouldBe` [4, 4, 5, 5, 6, 6]
-                    
+
+