diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,4 +1,9 @@
 
+3.2.0
+----------
+* Add arrow-tr flag
+* add `gSwitch`, `dgSwitch`
+
 3.1.0
 -----------
 * Add `Discrete` utilities
diff --git a/machinecell.cabal b/machinecell.cabal
--- a/machinecell.cabal
+++ b/machinecell.cabal
@@ -1,5 +1,5 @@
 name:                machinecell
-version:             3.1.0
+version:             3.2.0
 synopsis:            Arrow based stream transducers
 license:             BSD3
 license-file:        LICENSE
@@ -22,6 +22,12 @@
 	.
 	A quick introduction is available in the Control.Arrow.Machine documentation.
 
+flag arrow-tr
+  description:
+    Arrow transformer support.
+  default: True
+  manual: True
+
 library
   exposed-modules:
         Control.Arrow.Machine,
@@ -33,10 +39,13 @@
         Control.Arrow.Machine.Misc.Discrete
   other-extensions:    FlexibleInstances, Arrows, RankNTypes, TypeSynonymInstances, MultiParamTypeClasses, GADTs, FlexibleContexts, NoMonomorphismRestriction, RecursiveDo
   ghc-options: -Wall
-  build-depends:       base >=4.0 && <5.0, mtl >=2.0.1.1, free >=4.12 && < 5.0, profunctors >=4.0, arrows >=0.4.1.2, semigroups >=0.8.3.1
+  build-depends:       base >=4.0 && <5.0, mtl >=2.0.1.1, free >=4.12 && < 5.0, semigroups >=0.8.3.1, profunctors >=4.0
   hs-source-dirs:      src
   default-language:    Haskell2010
 
+  if flag(arrow-tr)
+    build-depends:    arrows >= 0.4.1.2
+
 Test-suite spec
   type:                exitcode-stdio-1.0
   default-language:    Haskell2010
@@ -53,4 +62,4 @@
 source-repository this
   type:		git
   location:	https://github.com/as-capabl/machinecell.git
-  tag:		release-3.1.0
+  tag:		release-3.2.0
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
@@ -18,7 +18,7 @@
         ary3,
         ary4,
         ary5,
-        
+
         kleisli,
         kleisli0,
         kleisli2,
@@ -28,9 +28,11 @@
 
         unArrowMonad,
         arrowMonad,
-                
+
+#if defined(MIN_VERSION_arrows)
         reading,
         statefully,
+#endif
 
         -- * Arrow construction helper (Lens)
         -- |Lens Isomorphisms between arrows and monads.
@@ -38,7 +40,9 @@
         -- Use with lens operator (^.) and (#).
         kl,
         am,
+#if defined(MIN_VERSION_arrows)
         rd,
+#endif
         uc0,
         uc1,
         uc2,
@@ -52,18 +56,22 @@
         toAS,
         fromAS,
 
+#if defined(MIN_VERSION_arrows)
         elimR
+#endif
     )
 where
 
 import Prelude hiding ((.), id)
 import Control.Category
 import Control.Arrow
+#if defined(MIN_VERSION_arrows)
 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.State (StateT, runStateT)
+#endif
 import Data.Profunctor
 
        
@@ -125,7 +133,7 @@
     a (a1, a2, a3, a4, a5) b
 ary5 f fmx = f $ \(x1, x2, x3, x4, x5) -> fmx x1 x2 x3 x4 x5
 
-         
+
 kleisli :: Monad m => (a->m b) -> Kleisli m a b
 kleisli = ary1 Kleisli
 
@@ -155,7 +163,8 @@
     a p q -> p -> ArrowMonad a q
 arrowMonad af x = ArrowMonad $ arr (const x) >>> af
 
-    
+
+#if defined(MIN_VERSION_arrows)
 reading :: 
     (Monad m, Arrow a) => 
     (forall p q. (p->m q)->a p q) -> 
@@ -174,7 +183,7 @@
     (y, s') <- liftState (f $ \(x, s) -> runStateT (ms x) s) -< (x, s)
     store -< s'
     returnA -< y
-    
+#endif
 
 type MyIso s t a b =
     forall p f. (Profunctor p, Functor f) =>
@@ -197,6 +206,7 @@
     MyIso' (b -> ArrowMonad a c) (a b c)
 am = myIso unArrowMonad arrowMonad
 
+#if defined(MIN_VERSION_arrows)
 rd ::
     (Arrow a) =>
     (forall p q. MyIso' (p -> m q) (a p q)) ->
@@ -207,6 +217,7 @@
         (\frmy -> uncurry (runReaderT . frmy))
         (\fmy -> ReaderT . (curry fmy))
     g = myIso ReaderArrow runReader
+#endif
 
 uc0 :: MyIso' (m b) (() -> m b)
 uc0 = myIso const ($())
@@ -234,11 +245,12 @@
     (\f (a1, a2, a3, a4, a5) -> f a1 a2 a3 a4 a5)
     (\f a1 a2 a3 a4 a5 -> f (a1, a2, a3, a4, a5))
 
+#if defined(MIN_VERSION_arrows)
 -- |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)
-
+#endif
 
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
@@ -23,6 +23,7 @@
         arr5,
 
         constant,
+        unsafeConstant,
         hold,
         accum,
         fromEq,
@@ -77,15 +78,18 @@
     P.ProcessA a (P.Event (), b) (T b)
 makeT = Arr.arr $ uncurry T
 
--- TODO this should be implemented by switch
-rising ::
+
+stimulate ::
     ArrowApply a =>
     P.ProcessA a b (T c) ->
     P.ProcessA a b (T c)
-rising sf = proc x ->
-  do
-    (dy, n) <- sf &&& P.now -< x
-    makeT -< (updates dy `mappend` n, value dy)
+stimulate sf = P.dgSwitch (id &&& id) sf body $ \sf' _ -> sf'
+  where
+    body = proc (dy, _) ->
+      do
+        n <- P.now -< ()
+        disc <- makeT -< (updates dy `mappend` n, value dy)
+        returnA -< (disc, updates disc)
 
 arr ::
     ArrowApply a =>
@@ -134,6 +138,15 @@
 constant x =
     (P.now &&& Arr.arr (const x)) >>> makeT
 
+-- |Constant without initial notifications.
+-- Users must manage initialization manually.
+unsafeConstant::
+    ArrowApply a =>
+    c ->
+    P.ProcessA a b (T c)
+unsafeConstant x =
+    (pure P.noEvent &&& Arr.arr (const x)) >>> makeT
+
 onUpdate ::
     ArrowApply a =>
     P.ProcessA a (P.Event b) (P.Event ())
@@ -182,7 +195,7 @@
     P.ProcessA a (b, T c) (P.Event t) ->
     (P.ProcessA a b (T c) -> t -> P.ProcessA a b (T c)) ->
     P.ProcessA a b (T c)
-kSwitch sf test k = P.kSwitch sf test (\sf' x -> rising (k sf' x))
+kSwitch sf test k = P.kSwitch sf test (\sf' x -> stimulate (k sf' x))
 
 dkSwitch ::
     ArrowApply a =>
@@ -190,7 +203,7 @@
     P.ProcessA a (b, T c) (P.Event t) ->
     (P.ProcessA a b (T c) -> t -> P.ProcessA a b (T c)) ->
     P.ProcessA a b (T c)
-dkSwitch sf test k = P.dkSwitch sf test (\sf' x -> rising (k sf' x))
+dkSwitch sf test k = P.dkSwitch sf test (\sf' x -> stimulate (k sf' x))
 
 
 {-$alg
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
@@ -2,6 +2,7 @@
 {-# LANGUAGE Arrows #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -13,6 +14,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE KindSignatures #-}
 
 module
     Control.Arrow.Machine.Types
@@ -74,17 +76,23 @@
         drSwitch,
         kSwitch,
         dkSwitch,
+        gSwitch,
+        dgSwitch,
         pSwitch,
         pSwitchB,
+        dpSwitch,
+        dpSwitchB,
         rpSwitch,
         rpSwitchB,
+        drpSwitch,
+        drpSwitchB,
         par,
         parB,
-        
+
         -- * Primitive machines - other safe primitives
         fit,
         fitW,
-        
+
         -- * Primitive machines - unsafe
         unsafeExhaust,
       )
@@ -129,6 +137,12 @@
 
 type ProcType a b c = ProcessA a b c
 
+class Stepper a b c s | s -> a, s -> b, s -> c
+  where
+    feed :: s -> a b (c, s)
+    sweep :: s -> a b (Maybe c, s)
+    suspend :: s -> b -> c
+
 -- | The stream transducer arrow.
 --
 -- To construct `ProcessA` instances, use `Control.Arrow.Machine.Plan.Plan`,
@@ -137,56 +151,55 @@
 --
 -- 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)
+    paFeed :: a b (c, ProcessA a b c),
+    paSweep :: a b (Maybe c, ProcessA a b c),
+    paSuspend :: !(b -> c)
   }
 
+instance
+    Stepper a b c (ProcessA a b c)
+  where
+    feed = paFeed
+    sweep = paSweep
+    suspend = paSuspend
 
+toProcessA ::
+    (ArrowApply a, Stepper a b c s) =>
+    s -> ProcessA a b c
+toProcessA s = ProcessA {
+    paFeed = feed s >>> arr (second toProcessA),
+    paSweep = sweep s >>> arr (second toProcessA),
+    paSuspend = suspend s
+  }
+{-# INLINE[2] toProcessA  #-}
+
 -- 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)
+    step ::
+        (ArrowApply a, Stepper a b c s) =>
+        s -> a b (f c, s)
     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
-                -<< ()
+    compositeStep ::
+        (ArrowApply a, Stepper a b p s1, Stepper a p c s2) =>
+        s1 -> s2 ->
+        a b (f c, s1, s2)
 
-    testStep' ::
-        ArrowApply a =>
-        (x -> a b (f c, x)) ->
-        (x -> b -> c) ->
-        x ->
-        ProcessA a (b, c) t ->
-        a b (f c, f t, x, ProcessA a (b, c) t)
 
-testStep ::
-    (ArrowApply a, ProcessHelper f) =>
-    ProcessA a b c ->
-    ProcessA a (b, c) t ->
-    a b (f c, f t, ProcessA a b c, ProcessA a (b, c) t)
-testStep = testStep' step suspend
-
 instance
     ProcessHelper Identity
   where
     step pa = feed pa >>> first (arr Identity)
     helperToMaybe = Just . runIdentity
     weakly = Identity
-    testStep' stp' _ sf test = proc x ->
+    compositeStep sf test = proc x ->
       do
-        (Identity y, sf') <- stp' sf -< x
-        (t, test') <- feed test -< (x, y)
-        returnA -< (return y, return t, sf', test')
+        (y, sf') <- feed sf -< x
+        (z, test') <- feed test -< y
+        returnA -< (return z, sf', test')
 
 instance
     ProcessHelper Maybe
@@ -194,26 +207,26 @@
     step = sweep
     helperToMaybe = id
     weakly _ = Nothing
-    testStep' stp' sus' sf0 test0 = proc x ->
+    compositeStep sf0 test0 = proc x ->
       do
-        let y = sus' sf0 x
-        (mt, test') <- sweep test0 -< (x, y)
+        let y = suspend sf0 x
+        (mt, test') <- sweep test0 -< y
         (case mt of
-            Just t -> arr $ const (Just y, Just t, sf0, test')
+            Just t -> arr $ const (Just t, sf0, test')
             Nothing -> cont sf0 test')
                 -<< x
       where
         cont sf test = proc x ->
           do
-            (my, sf') <- stp' sf -< x
+            (my, sf') <- sweep sf -< x
             (case my of
                 Just y -> cont2 y sf' test
-                Nothing -> arr $ const (Nothing, Nothing, sf', test))
+                Nothing -> arr $ const (Nothing, sf', test))
                     -<< x
-        cont2 y sf test = proc x ->
+        cont2 y sf test = proc _ ->
           do
-            (t, test') <- feed test -< (x, y)
-            returnA -< (Just y, Just t, sf, test')
+            (t, test') <- feed test -< y
+            returnA -< (Just t, sf, test')
 
 makePA ::
     Arrow a =>
@@ -222,12 +235,79 @@
     (b -> c) ->
     ProcessA a b c
 makePA h !sus = ProcessA {
-    feed = h >>> first (arr runIdentity),
-    sweep = h,
-    suspend = sus
+    paFeed = h >>> first (arr runIdentity),
+    paSweep = h,
+    paSuspend = sus
   }
 
 
+data CompositeStep a b c s1 s2
+  where
+    CompositeStep ::
+        (Stepper a b p s1, Stepper a p c s2) =>
+        s1 -> s2 ->
+        CompositeStep a b c s1 s2
+
+instance
+    ArrowApply a => Stepper a b c (CompositeStep a b c s1 s2)
+  where
+    feed (CompositeStep s1 s2) =
+        compositeStep s1 s2 >>>
+            arr (\(fz, s1', s2') -> (runIdentity $ fz, CompositeStep s1' s2'))
+    sweep (CompositeStep s1 s2) =
+        compositeStep s1 s2 >>>
+            arr (\(fz, s1', s2') -> (fz, CompositeStep s1' s2'))
+    suspend (CompositeStep s1 s2) =
+        suspend s2 . suspend s1
+
+
+data IDStep a b c
+  where
+    IDStep :: IDStep (a :: * -> * -> *) b b
+
+instance
+    ArrowApply a => Stepper a b c (IDStep a b c)
+  where
+    feed IDStep = Cat.id &&& arr (const IDStep)
+    sweep IDStep = arr (const (Nothing, IDStep))
+    suspend IDStep = id
+
+newtype ArrStep (a :: * -> * -> *) b c = ArrStep (b -> c)
+
+instance
+    ArrowApply a => Stepper a b c (ArrStep a b c)
+  where
+    feed (ArrStep f) = arr $ \x -> (f x, ArrStep f)
+    sweep (ArrStep f) = arr $ const (Nothing, ArrStep f)
+    suspend (ArrStep f) = f
+
+
+data ParStep a b c s1 s2
+  where
+    ParStep ::
+        (Stepper a b1 c1 s1, Stepper a b2 c2 s2) =>
+        s1 -> s2 ->
+        ParStep a (b1, b2) (c1, c2) s1 s2
+
+instance
+    ArrowApply a => Stepper a b c (ParStep a b c s1 s2)
+  where
+    feed (ParStep f g) = proc (x1, x2) ->
+      do
+        (y1, f') <- feed f -< x1
+        (y2, g') <- feed g -< x2
+        returnA -< ((y1, y2), ParStep f' g')
+    sweep (ParStep f g) = 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, ParStep f' g')
+    suspend (ParStep f g) = suspend f *** suspend g
+
+
 -- |Natural transformation
 fit ::
     (ArrowApply a, ArrowApply a') =>
@@ -283,6 +363,7 @@
   where
     id = idProc
     {-# INLINE id #-}
+
     g . f = compositeProc f g
     {-# INLINE (.) #-}
 
@@ -307,23 +388,8 @@
     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 #-}
+parProc f g = toProcessA $ ParStep f g
+{-# INLINE [0] parProc #-}
 
 idProc :: ArrowApply a => ProcType a b b
 idProc = makePA (arr $ \x -> (weakly x, idProc)) id
@@ -337,12 +403,12 @@
 compositeProc :: ArrowApply a =>
               ProcType a b d -> ProcType a d c -> ProcType a b c
 compositeProc f0 g0 = ProcessA {
-    feed = proc x ->
+    paFeed = proc x ->
       do
         (y, f') <- feed f0 -< x
         (z, g') <- feed g0 -< y
         returnA -< (z, compositeProc f' g'),
-    sweep = proc x ->
+    paSweep = proc x ->
       do
         (mz, g') <- sweep g0 -< suspend f0 x
         (case mz
@@ -350,7 +416,7 @@
             Just z -> arr $ const (Just z, compositeProc f0 g')
             Nothing -> btrk f0 g')
                 -<< x,
-    suspend = suspend f0 >>> suspend g0
+    paSuspend = suspend f0 >>> suspend g0
   }
   where
     btrk f g = proc x ->
@@ -683,9 +749,9 @@
         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
+        paFeed = proc ex -> do { r <- fit0 mr -< (); prependFeed r -<< ex} ,
+        paSweep = proc ex -> do { r <- fit0 mr -< (); prependSweep r -<< ex},
+        paSuspend = const NoEvent
       }
 
     prependFeed (Event x, pa) = arr $ const (Event x, pa)
@@ -714,9 +780,9 @@
         return (End, stopped)
 
     awaitProc fma = ProcessA {
-        feed = fit' fma,
-        sweep = fit' fma >>> first eToM,
-        suspend = const NoEvent
+        paFeed = fit' fma,
+        paSweep = fit' fma >>> first eToM,
+        paSuspend = const NoEvent
       }
 
     eToM :: a (Event b) (Maybe (Event b))
@@ -753,17 +819,7 @@
     ProcessA a b (c, Event t) ->
     (t -> ProcessA a b c) ->
     ProcessA a b c
-switch sf k = makePA
-    (proc x ->
-      do
-        (hy, sf') <- step sf -< x
-        let hevt = fmap snd hy
-        (case (helperToMaybe hevt)
-          of
-            Just (Event t) -> step (k t)
-            _ -> arr $ const (fst <$> hy, switch sf' k))
-                -<< x)
-    (fst . suspend sf)
+switch sf k = ggSwitch (const ()) sf (\() -> k)
 
 
 dSwitch ::
@@ -771,18 +827,7 @@
     ProcessA a b (c, Event t) ->
     (t -> ProcessA a b c) ->
     ProcessA a b c
-dSwitch sf k = makePA
-    (proc x ->
-      do
-        (hyevt, sf') <- step sf -< x
-        let hevt = fmap snd hyevt
-            hy = fmap fst hyevt
-        (case (helperToMaybe hevt)
-          of
-            Just (Event t) -> arr $ const (hy, k t)
-            _ -> arr $ const (hy, dSwitch sf' k))
-                -<< x)
-    (fst . suspend sf)
+dSwitch sf k = dggSwitch (const ()) sf (\() -> k)
 
 
 rSwitch ::
@@ -810,34 +855,89 @@
     ProcessA a (b, c) (Event t) ->
     (ProcessA a b c -> t -> ProcessA a b c) ->
     ProcessA a b c
-kSwitch sf test k = makePA
-    (proc x ->
-      do
-        (hy, hevt, sf', test') <- testStep sf test -< x
-        (case (helperToMaybe hevt)
-          of
-            Just (Event t) -> step (k sf' t)
-            _ -> arr $ const (hy, kSwitch sf' test' k))
-                -<< x)
-    (suspend sf)
+kSwitch sf test =
+    ggSwitch
+        (\(CompositeStep _ (CompositeStep (ParStep IDStep sf') _)) -> sf')
+        (CompositeStep (ArrStep (id &&& id))
+           (CompositeStep (ParStep IDStep sf) (arr snd &&& test)))
 
+
 dkSwitch ::
     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
-dkSwitch sf test k = makePA
+dkSwitch sf test =
+    dggSwitch
+        (\(CompositeStep _ (CompositeStep (ParStep IDStep sf') _)) -> sf')
+        (CompositeStep (ArrStep (id &&& id))
+           (CompositeStep (ParStep IDStep sf) (arr snd &&& test)))
+
+ggSwitch ::
+    (ArrowApply a, Stepper a b (c, Event t) sWhole) =>
+    (sWhole -> s) ->
+    sWhole ->
+    (s -> t -> ProcessA a b c) ->
+    ProcessA a b c
+ggSwitch picker whole k = makePA
     (proc x ->
       do
-        (hy, hevt, sf', test') <- testStep sf test -< x
+        let
+        (hyevt, whole') <- step whole -<< x
+        let hy = fst <$> hyevt
+            hevt = snd <$> hyevt
         (case (helperToMaybe hevt)
           of
-            Just (Event t) -> arr $ const (hy, k sf' t)
-            _ -> arr $ const (hy, dkSwitch sf' test' k))
+            Just (Event t) -> step (k (picker whole') t)
+            _ -> arr $ const (hy, ggSwitch picker whole' k))
                 -<< x)
-    (suspend sf)
+    (arr fst . suspend whole)
 
+dggSwitch ::
+    (ArrowApply a, Stepper a b (c, Event t) sWhole) =>
+    (sWhole -> s) ->
+    sWhole ->
+    (s -> t -> ProcessA a b c) ->
+    ProcessA a b c
+dggSwitch picker whole k = makePA
+    (proc x ->
+      do
+        let
+        (hyevt, whole') <- step whole -<< x
+        let hy = fst <$> hyevt
+            hevt = snd <$> hyevt
+        (case (helperToMaybe hevt)
+          of
+            Just (Event t) -> arr $ const (hy, k (picker whole') t)
+            _ -> arr $ const (hy, dggSwitch picker whole' k))
+                -<< x)
+    (arr fst . suspend whole)
+
+gSwitch ::
+    ArrowApply a =>
+    ProcessA a b (p, r) ->
+    ProcessA a p q ->
+    ProcessA a (q, r) (c, Event t) ->
+    (ProcessA a p q -> t -> ProcessA a b c) ->
+    ProcessA a b c
+gSwitch pre sf post =
+    ggSwitch
+        (\(CompositeStep _ (CompositeStep (ParStep sf' IDStep) _)) -> sf')
+        (CompositeStep pre (CompositeStep (ParStep sf IDStep) post))
+
+dgSwitch ::
+    ArrowApply a =>
+    ProcessA a b (p, r) ->
+    ProcessA a p q ->
+    ProcessA a (q, r) (c, Event t) ->
+    (ProcessA a p q -> t -> ProcessA a b c) ->
+    ProcessA a b c
+dgSwitch pre sf post =
+    dggSwitch
+        (\(CompositeStep _ (CompositeStep (ParStep sf' IDStep) _)) -> sf')
+        (CompositeStep pre (CompositeStep (ParStep sf IDStep) post))
+
 broadcast ::
     Functor col =>
     b -> col sf -> col (b, sf)
@@ -848,10 +948,7 @@
     (forall sf. (b -> col sf -> col (ext, sf))) ->
     col (ProcessA a ext c) ->
     ProcessA a b (col c)
-par r sfs =
-    makePA
-        (parCore r sfs >>> second (arr (par r)))
-        (suspendAll r sfs)
+par r sfs = toProcessA (PluralStep r sfs)
 
 parB ::
     (ArrowApply a, Tv.Traversable col) =>
@@ -859,6 +956,23 @@
     ProcessA a b (col c)
 parB = par broadcast
 
+
+data PluralStep ext col a b c
+  where
+    PluralStep ::
+        (forall sf. (b -> col sf -> col (ext, sf))) ->
+        (col (ProcessA a ext c)) ->
+        PluralStep ext col a b c
+
+
+instance
+    (ArrowApply a, Tv.Traversable col) =>
+    Stepper a b (col c) (PluralStep ext col a b c)
+  where
+    feed (PluralStep r sfs) = parCore r sfs >>> arr (runIdentity *** PluralStep r)
+    sweep (PluralStep r sfs) = parCore r sfs >>> arr (id *** PluralStep r)
+    suspend (PluralStep r sfs) = suspendAll r sfs
+
 suspendAll ::
     (ArrowApply a, Tv.Traversable col) =>
     (forall sf. (b -> col sf -> col (ext, sf))) ->
@@ -913,17 +1027,12 @@
     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 = makePA
-    (proc x ->
-      do
-        (hzs, hevt, sfs', test') <-
-            testStep' (parCore r) (suspendAll r) sfs test -< x
-        (case helperToMaybe hevt
-          of
-            Just (Event t) -> (step (k sfs' t))
-            _ -> arr $ const (hzs, pSwitch r sfs' test' k))
-                -<< x)
-    (suspendAll r sfs)
+pSwitch r sfs test =
+    ggSwitch
+        (\(CompositeStep _
+            (CompositeStep (ParStep IDStep (PluralStep _ sfs')) _)) -> sfs')
+        (CompositeStep (ArrStep (id &&& id))
+            (CompositeStep (ParStep IDStep (PluralStep r sfs)) (arr snd &&& test)))
 
 pSwitchB ::
     (ArrowApply a, Tv.Traversable col) =>
@@ -933,7 +1042,27 @@
     ProcessA a b (col c)
 pSwitchB = pSwitch broadcast
 
+dpSwitch ::
+    (ArrowApply a, Tv.Traversable col) =>
+    (forall sf. (b -> col sf -> col (ext, sf))) ->
+    col (ProcessA a ext c) ->
+    ProcessA a (b, col c) (Event mng) ->
+    (col (ProcessA a ext c) -> mng -> ProcessA a b (col c)) ->
+    ProcessA a b (col c)
+dpSwitch r sfs test =
+    dggSwitch
+        (\(CompositeStep _
+            (CompositeStep (ParStep IDStep (PluralStep _ sfs')) _)) -> sfs')
+        (CompositeStep (ArrStep (id &&& id))
+            (CompositeStep (ParStep IDStep (PluralStep r sfs)) (arr snd &&& test)))
 
+dpSwitchB ::
+    (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)
+dpSwitchB = dpSwitch broadcast
 
 rpSwitch ::
     (ArrowApply a, Tv.Traversable col) =>
@@ -942,13 +1071,24 @@
     ProcessA a
         (b, Event (col (ProcessA a ext c) -> col (ProcessA a ext c)))
         (col c)
-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)
+rpSwitch r sfs =
+    ggSwitch
+        (\(ParStep (PluralStep _ sfs') IDStep) -> sfs')
+        (ParStep (PluralStep r sfs) IDStep)
+        (\sfs' tr -> next r (tr sfs'))
+  where
+    next ::
+        (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)))
+            (col c)
+    next r' sfs' =
+        dggSwitch
+            (\(ParStep (PluralStep _ sfs'') IDStep) -> sfs'')
+            (ParStep (PluralStep r' sfs') IDStep)
+            (\sfs'' _ -> rpSwitch r' sfs'')
 
 
 rpSwitchB ::
@@ -959,9 +1099,29 @@
         (col c)
 rpSwitchB = rpSwitch broadcast
 
--- `dpSwitch` and `drpSwitch` are not implemented.
 
+drpSwitch ::
+    (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)))
+        (col c)
+drpSwitch r sfs =
+    dggSwitch
+        (\(ParStep (PluralStep _ sfs') IDStep) -> sfs')
+        (ParStep (PluralStep r sfs) IDStep)
+        (\sfs' tr -> drpSwitch r (tr sfs'))
 
+drpSwitchB ::
+    (ArrowApply a, Tv.Traversable col) =>
+    col (ProcessA a b c) ->
+    ProcessA a
+        (b, Event (col (ProcessA a b c) -> col (ProcessA a b c)))
+        (col c)
+drpSwitchB = drpSwitch broadcast
+
+
 --
 -- Unsafe primitives
 --
@@ -984,9 +1144,9 @@
     go >>> fork
   where
     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
+        paFeed = p >>> arr (\y -> (Event y, go)),
+        paSweep = p >>> arr (\y -> (if nullFd y then Nothing else Just (Event y), go)),
+        paSuspend = const NoEvent
       }
 
     fork = repeatedly $ await >>= Fd.mapM_ yield
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
@@ -56,9 +56,10 @@
         parB,
         now,
         onEnd,
-
+#if defined(MIN_VERSION_arrows)
         -- * Transformer
         readerProc
+#endif
      )
 where
 
@@ -71,8 +72,9 @@
 import Control.Monad.State
 import Control.Arrow
 import Control.Applicative
+#if defined(MIN_VERSION_arrows)
 import Control.Arrow.Transformer.Reader (ArrowAddReader(..))
-
+#endif
 import Control.Arrow.Machine.ArrowUtil
 import Control.Arrow.Machine.Types
 
@@ -325,6 +327,8 @@
     go = repeatedly $
         await `catchP` (yield () >> stop)
 
+
+#if defined(MIN_VERSION_arrows)
 -- | Run reader of base arrow.
 readerProc ::
     (ArrowApply a, ArrowApply a', ArrowAddReader r a a') =>
@@ -334,4 +338,4 @@
   where
     swap :: (a, b) -> (b, a)
     swap ~(a, b) = (b, a)
-
+#endif