diff --git a/.gitignore b/.gitignore
--- a/.gitignore
+++ b/.gitignore
@@ -11,3 +11,4 @@
 *.hi
 *~
 *#
+.cabal-sandbox
diff --git a/README.markdown b/README.markdown
--- a/README.markdown
+++ b/README.markdown
@@ -21,7 +21,7 @@
 There is a lot of flexibility when building a machine in choosing between empowering the machine to run its own monadic effects
 or delegating that responsibility to a custom driver.
 
-A port of this design to scala is available from runarorama/machines
+A port of this design to scala is available from runarorama/scala-machines
 
 Runar's slides are also available from https://dl.dropbox.com/u/4588997/Machines.pdf
 
diff --git a/machines.cabal b/machines.cabal
--- a/machines.cabal
+++ b/machines.cabal
@@ -1,6 +1,6 @@
 name:          machines
 category:      Control, Enumerator
-version:       0.2.3.1
+version:       0.2.4
 license:       BSD3
 cabal-version: >= 1.10
 license-file:  LICENSE
@@ -41,11 +41,13 @@
     profunctors  >= 3,
     semigroups   >= 0.8.3,
     transformers == 0.3.*,
-    mtl          >= 2 && < 2.2
+    mtl          >= 2 && < 2.2,
+    void         >= 0.6.1 && < 0.7
 
   exposed-modules:
     Data.Machine
     Data.Machine.Is
+    Data.Machine.Fanout
     Data.Machine.Mealy
     Data.Machine.Moore
     Data.Machine.Process
diff --git a/src/Data/Machine/Fanout.hs b/src/Data/Machine/Fanout.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Machine/Fanout.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE GADTs #-}
+-- | Provide a notion of fanout wherein a single input is passed to
+-- several consumers.
+module Data.Machine.Fanout (fanout, fanoutSteps) where
+import Control.Applicative
+import Control.Arrow
+import Control.Monad (foldM)
+import Data.Machine
+import Data.Maybe (catMaybes)
+import Data.Monoid
+import Data.Semigroup (Semigroup(sconcat))
+import Data.List.NonEmpty (NonEmpty((:|)))
+
+-- | Feed a value to a 'ProcessT' at an 'Await' 'Step'. If the
+-- 'ProcessT' is awaiting a value, then its next step is
+-- returned. Otherwise, the original process is returned.
+feed :: Monad m => a -> ProcessT m a b -> m (Step (Is a) b (ProcessT m a b))
+feed x m = runMachineT m >>= \v ->
+            case v of
+              Await f Refl _ -> runMachineT (f x)
+              s -> return s
+
+-- | Like 'Data.List.mapAccumL' but with a monadic accumulating
+-- function.
+mapAccumLM :: (Functor m, Monad m)
+           => (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
+mapAccumLM f z = fmap (second ($ [])) . foldM aux (z,id)
+  where aux (acc,ys) x = second ((. ys) . (:)) <$> f acc x
+
+-- | Exhaust a sequence of all successive 'Yield' steps taken by a
+-- 'MachineT'. Returns the list of yielded values and the next
+-- (non-Yield) step of the machine.
+flushYields :: Monad m
+            => Step k o (MachineT m k o) -> m ([o], Maybe (MachineT m k o))
+flushYields = go id
+  where go rs (Yield o s) = runMachineT s >>= go ((o:) . rs)
+        go rs Stop = return (rs [], Nothing)
+        go rs s = return (rs [], Just $ encased s)
+
+-- | Share inputs with each of a list of processes in lockstep. Any
+-- values yielded by the processes are combined into a single yield
+-- from the composite process.
+fanout :: (Functor m, Monad m, Semigroup r)
+       => [ProcessT m a r] -> ProcessT m a r
+fanout xs = encased $ Await (MachineT . aux) Refl (fanout xs)
+  where aux y = do (rs,xs') <- mapM (feed y) xs >>= mapAccumLM yields []
+                   let nxt = fanout $ catMaybes xs'
+                   case rs of
+                     [] -> runMachineT nxt
+                     (r:rs') -> return $ Yield (sconcat $ r :| rs') nxt
+        yields rs Stop = return (rs,Nothing)
+        yields rs y@(Yield _ _) = first (++ rs) <$> flushYields y
+        yields rs a@(Await _ _ _) = return (rs, Just $ encased a)
+
+-- | Share inputs with each of a list of processes in lockstep. If
+-- none of the processes yields a value, the composite process will
+-- itself yield 'mempty'. The idea is to provide a handle on steps
+-- only executed for their side effects. For instance, if you want to
+-- run a collection of 'ProcessT's that await but don't yield some
+-- number of times, you can use 'fanOutSteps . map (fmap (const ()))'
+-- followed by a 'taking' process.
+fanoutSteps :: (Functor m, Monad m, Monoid r)
+            => [ProcessT m a r] -> ProcessT m a r
+fanoutSteps xs = encased $ Await (MachineT . aux) Refl (fanoutSteps xs)
+  where aux y = do (rs,xs') <- mapM (feed y) xs >>= mapAccumLM yields []
+                   let nxt = fanoutSteps $ catMaybes xs'
+                   if null rs
+                   then return $ Yield mempty nxt
+                   else return $ Yield (mconcat rs) nxt
+        yields rs Stop = return (rs,Nothing)
+        yields rs y@(Yield _ _) = first (++rs) <$> flushYields y
+        yields rs a@(Await _ _ _) = return (rs, Just $ encased a)
diff --git a/src/Data/Machine/Mealy.hs b/src/Data/Machine/Mealy.hs
--- a/src/Data/Machine/Mealy.hs
+++ b/src/Data/Machine/Mealy.hs
@@ -129,6 +129,15 @@
     Right b -> case runMealy n b of
       (d, n') -> (d, m ||| n')
 
+#if MIN_VERSION_profunctors(3,2,0)
+instance Strong Mealy where
+  first' = first
+
+instance Choice Mealy where
+  left' = left
+  right' = right
+#endif
+
 -- | Fast forward a mealy machine forward
 driveMealy :: Mealy a b -> Seq a -> a -> (b, Mealy a b)
 driveMealy m xs z = case viewl xs of
diff --git a/src/Data/Machine/Moore.hs b/src/Data/Machine/Moore.hs
--- a/src/Data/Machine/Moore.hs
+++ b/src/Data/Machine/Moore.hs
@@ -23,7 +23,6 @@
 
 import Control.Applicative
 import Control.Comonad
-import Control.Monad
 import Data.Copointed
 import Data.Machine.Plan
 import Data.Machine.Type
@@ -90,8 +89,8 @@
 instance Monad (Moore a) where
   return a = r where r = Moore a (const r)
   {-# INLINE return #-}
-  Moore a k >>= f = case f a of
-    Moore b _ -> Moore b (k >=> f)
+  k >>= f = j (fmap f k) where
+    j (Moore a g) = Moore (extract a) (\x -> j $ fmap (\(Moore _ h) -> h x) (g x))
   _ >> m = m
 
 instance Copointed (Moore a) where
diff --git a/src/Data/Machine/Plan.hs b/src/Data/Machine/Plan.hs
--- a/src/Data/Machine/Plan.hs
+++ b/src/Data/Machine/Plan.hs
@@ -52,7 +52,7 @@
   { runPlanT :: forall r.
       (a -> m r) ->                                     -- Done a
       (o -> m r -> m r) ->                              -- Yield o (Plan k o a)
-      (forall z. (z -> m r) -> k z -> m r -> m r) ->  -- forall z. Await (z -> Plan o a) (k z) (Plan k o a)
+      (forall z. (z -> m r) -> k z -> m r -> m r) ->    -- forall z. Await (z -> Plan k o a) (k z) (Plan k o a)
       m r ->                                            -- Fail
       m r
   }
@@ -130,20 +130,20 @@
   {-# INLINE get #-}
   put = lift . put
   {-# INLINE put #-}
-#ifdef MIN_VERSION_mtl(2,1,0)
+#if MIN_VERSION_mtl(2,1,0)
   state f = PlanT $ \kp _ _ _ -> state f >>= kp
   {-# INLINE state #-}
 #endif
 
 instance MonadReader e m => MonadReader e (PlanT k o m) where
   ask = lift ask
-#ifdef MIN_VERSION_mtl(2,1,0)
+#if MIN_VERSION_mtl(2,1,0)
   reader = lift . reader
 #endif
   local f m = PlanT $ \kp ke kr kf -> local f (runPlanT m kp ke kr kf)
 
 instance MonadWriter w m  => MonadWriter w (PlanT k o m) where
-#ifdef MIN_VERSION_mtl(2,1,0)
+#if MIN_VERSION_mtl(2,1,0)
   writer = lift . writer
 #endif
   tell   = lift . tell
diff --git a/src/Data/Machine/Process.hs b/src/Data/Machine/Process.hs
--- a/src/Data/Machine/Process.hs
+++ b/src/Data/Machine/Process.hs
@@ -30,16 +30,23 @@
   , droppingWhile
   , takingWhile
   , buffered
+  , fold
+  , scan
+  , asParts
+  , sinkPart_
+  , autoM
   ) where
 
 import Control.Applicative
 import Control.Category
 import Control.Monad (liftM, when, replicateM_)
-import Data.Foldable
+import Control.Monad.Trans.Class
+import Data.Foldable hiding (fold)
 import Data.Machine.Is
 import Data.Machine.Plan
 import Data.Machine.Type
-import Prelude hiding ((.),id)
+import Data.Void
+import Prelude hiding ((.), id, mapM_)
 
 infixr 9 <~
 infixl 9 ~>
@@ -155,3 +162,57 @@
   f' (Yield o k)     = Yield o (process f k)
   f' Stop            = Stop
   f' (Await g kir h) = Await (process f . g . f kir) Refl (process f h)
+
+-- | 
+-- Construct a 'Process' from a left-scanning operation.
+--
+-- Like 'fold', but yielding intermediate values.
+--
+-- @
+-- 'scan' :: (a -> b -> a) -> a -> Process b a
+-- @  
+scan :: Category k => (a -> b -> a) -> a -> Machine (k b) a
+scan func seed = construct $ go seed where
+  go cur = do
+    next <- await
+    yield $ func cur next
+    go $ func cur next
+
+-- | 
+-- Construct a 'Process' from a left-folding operation.
+--
+-- Like 'scan', but only yielding the final value.
+--
+-- @
+-- 'fold' :: (a -> b -> a) -> a -> Process b a
+-- @
+fold :: Category k => (a -> b -> a) -> a -> Machine (k b) a
+fold func seed = construct $ go seed where
+  go cur = do
+    next <- await <|> yield cur *> stop
+    go (func cur next)
+
+-- | Break each input into pieces that are fed downstream
+-- individually.
+asParts :: Foldable f => Process (f a) a
+asParts = repeatedly $ await >>= mapM_ yield
+
+-- | @sinkPart_ toParts sink@ creates a process that uses the
+-- @toParts@ function to break input into a tuple of @(passAlong,
+-- sinkPart)@ for which the second projection is given to the supplied
+-- @sink@ 'ProcessT' (that produces no output) while the first
+-- projection is passed down the pipeline.
+sinkPart_ :: Monad m => (a -> (b,c)) -> ProcessT m c Void -> ProcessT m a b
+sinkPart_ p = go
+  where go m = MachineT $ runMachineT m >>= \v -> case v of
+          Stop -> return Stop
+          Yield _ k -> runMachineT $ go k
+          Await f Refl ff -> return $
+            Await (\x -> let (keep,sink) = p x
+                         in encased . Yield keep $ go (f sink))
+                  Refl
+                  (go ff)
+
+-- | Apply a monadic function to each element of a 'ProcessT'.
+autoM :: Monad m => (a -> m b) -> ProcessT m a b
+autoM f = repeatedly $ await >>= lift . f >>= yield
diff --git a/src/Data/Machine/Type.hs b/src/Data/Machine/Type.hs
--- a/src/Data/Machine/Type.hs
+++ b/src/Data/Machine/Type.hs
@@ -32,6 +32,7 @@
 
   -- * Reshaping machines
   , fit
+  , fitM
   , pass
 
   , stopped
@@ -169,6 +170,15 @@
   f' (Yield o k)     = Yield o (fit f k)
   f' Stop            = Stop
   f' (Await g kir h) = Await (fit f . g) (f kir) (fit f h)
+
+--- | Connect machine transformers over different monads using a monad
+--- morphism.
+fitM :: (Monad m, Monad m')
+     => (forall a. m a -> m' a) -> MachineT m k o -> MachineT m' k o
+fitM f (MachineT m) = MachineT $ f (liftM aux m)
+  where aux Stop = Stop
+        aux (Yield o k) = Yield o (fitM f k)
+        aux (Await g kg gg) = Await (fitM f . g) kg (fitM f gg)
 
 -- | Compile a machine to a model.
 construct :: Monad m => PlanT k o m a -> MachineT m k o