diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,4 +1,12 @@
 
+3.3.0
+----------
+* Correct a space leak problem
+* Add `splitEvent`, `oneshot`
+* Generalize some functions
+    * construct, repeatedly
+    * filterEvent, filterJust, filterLeft, filterRight
+
 3.2.0
 ----------
 * Add arrow-tr flag
diff --git a/machinecell.cabal b/machinecell.cabal
--- a/machinecell.cabal
+++ b/machinecell.cabal
@@ -1,5 +1,5 @@
 name:                machinecell
-version:             3.2.0
+version:             3.3.0
 synopsis:            Arrow based stream transducers
 license:             BSD3
 license-file:        LICENSE
@@ -39,7 +39,7 @@
         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, semigroups >=0.8.3.1, profunctors >=4.0
+  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, transformers
   hs-source-dirs:      src
   default-language:    Haskell2010
 
@@ -62,4 +62,4 @@
 source-repository this
   type:		git
   location:	https://github.com/as-capabl/machinecell.git
-  tag:		release-3.2.0
+  tag:		release-3.3.0
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
@@ -31,6 +31,7 @@
         filterJust,
         filterLeft,
         filterRight,
+        splitEvent,
         evMap,
 
         -- * Coroutine monad
@@ -103,10 +104,11 @@
 import Control.Arrow
 import Control.Monad
 import Control.Monad.Trans
-import Control.Monad.State
+import Control.Monad.State.Strict
 import Control.Monad.Reader
 import Control.Monad.Writer hiding ((<>))
 import Control.Monad.Identity
+import Control.Monad.Trans.Cont (ContT(..), evalContT, callCC)
 import Control.Applicative
 import Data.Foldable as Fd
 import Data.Traversable as Tv
@@ -588,22 +590,40 @@
 condEvent True ev = ev
 condEvent False _ = NoEvent
 
-filterEvent :: (a -> Bool) -> Event a -> Event a
-filterEvent cond ev@(Event x) = condEvent (cond x) ev
-filterEvent _ ev = ev
+filterEvent ::
+    Arrow ar =>
+    (a -> Bool) ->
+    ar (Event a) (Event a)
+filterEvent cond = filterJust <<< evMap mcond
+  where
+    mcond x
+        | cond x = Just x
+        | otherwise = Nothing
 
-filterJust :: Event (Maybe a) -> Event a
-filterJust (Event (Just x)) = Event x
-filterJust (Event Nothing) = NoEvent
-filterJust NoEvent = NoEvent
-filterJust End = End
+filterJust ::
+    Arrow ar => ar (Event (Maybe a)) (Event a)
+filterJust = arr filterJust'
+  where
+    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))
+filterLeft ::
+    Arrow ar =>
+    ar (Event (Either a b)) (Event a)
+filterLeft = filterJust <<< evMap (either Just (const Nothing))
 
-filterRight :: Event (Either a b) -> Event b
-filterRight = filterJust . fmap (either (const Nothing) Just)
+filterRight ::
+    Arrow ar =>
+    ar (Event (Either a b)) (Event b)
+filterRight = filterJust <<< evMap (either (const Nothing) Just)
 
+splitEvent ::
+    Arrow ar =>
+    ar (Event (Either a b)) (Event a, Event b)
+splitEvent = filterLeft &&& filterRight
+
 -- | Alias of "arr . fmap"
 --
 -- While "ProcessA a (Event b) (Event c)" means a transducer from b to c,
@@ -796,19 +816,19 @@
               PlanT i o m r ->
               ProcessA a (Event i) (Event o)
 
-repeatedlyT f pl = constructT f $ forever pl
+repeatedlyT f = constructT f . forever
 
 
 -- for pure
 construct :: ArrowApply a =>
-             Plan i o t ->
+             PlanT i o Identity r ->
              ProcessA a (Event i) (Event o)
-construct pl = constructT (ary0 unArrowMonad) pl
+construct = constructT (arr . const . runIdentity)
 
 repeatedly :: ArrowApply a =>
-              Plan i o t ->
+              PlanT i o Identity r ->
               ProcessA a (Event i) (Event o)
-repeatedly pl = construct $ forever pl
+repeatedly = construct . forever
 
 
 --
@@ -1158,42 +1178,16 @@
 --
 -- Running
 --
---
--- Utilities
---
-while_ ::
-    Monad m =>
-    m Bool -> m a -> m ()
-while_ cond body =
-  do
-    b <- cond
-    if b
-        then body >> while_ cond body
-        else return ()
 
--- | Monoid wrapper
-data WithEnd r = WithEnd {
-    getRWE :: r,
-    getContWE :: !Bool
-  }
-
-instance
-    Monoid r => Monoid (WithEnd r)
-  where
-    mempty = WithEnd mempty True
-    WithEnd x True `mappend` WithEnd y b = WithEnd (x `mappend` y) b
-    mx@(WithEnd _ False) `mappend` _ = mx
-
-
 --
 -- Running Monad (To be exported)
 --
 data RunInfo a i o m = RunInfo {
-    freezeRI :: ProcessA a i o,
-    getInputRI :: i,
-    getPaddingRI :: i,
-    getPhaseRI :: Phase,
-    getFitRI :: forall p q. a p q -> p -> m q
+    freezeRI :: !(ProcessA a i o),
+    getInputRI :: !i,
+    getPaddingRI :: !i,
+    getPhaseRI :: !Phase,
+    getFitRI :: !(forall p q. a p q -> p -> m q)
   }
 
 type RM a i o m = StateT (RunInfo a i o m) m
@@ -1217,8 +1211,8 @@
 
 
 feed_ ::
-    Monad m =>
-    i -> i -> RM a i o m Bool
+    (Monad m, MonadState (RunInfo a i o m') m) =>
+    i -> i -> m Bool
 feed_ input padding =
   do
     ph <- gets getPhaseRI
@@ -1236,24 +1230,16 @@
             return False
 
 feedR ::
-    Monad m =>
-    i -> RM a (Event i) o m Bool
+    (Monad m, MonadState (RunInfo a (Event i) o m') m) =>
+    i -> m Bool
 feedR x = feed_ (Event x) NoEvent
 
 
-{-
-finalizeE ::
-    Monad m =>
-    RM a (Event i) o m Bool
-finalizeE = feed_ End End
--}
-
 freeze ::
     Monad m =>
     RM a i o m (ProcessA a i o)
 freeze = gets freezeRI
 
-
 sweepR ::
     Monad m =>
     RM a i o m o
@@ -1289,28 +1275,34 @@
             return $ suspend pa x
 
 
-
-
-
 sweepAll ::
     (ArrowApply a, Monoid r, Monad m) =>
     (o->r) ->
-    WriterT (WithEnd r) (RM a i (Event o) m) ()
+    ContT Bool (StateT r (RM a i (Event o) m)) ()
 sweepAll outpre =
-        while_
-            ((not . (== Suspend)) `liftM` lift (gets getPhaseRI)) $
-          do
-            evx <- lift sweepR
-            case evx
-              of
-                Event x ->
-                    tell (WithEnd (outpre x) True)
-                NoEvent ->
-                    return ()
-                End ->
-                    tell (WithEnd mempty False)
+    callCC $ \sus -> forever $ cond sus >> body
+  where
+    cond sus =
+      do
+        ph <- lift $ lift $ gets getPhaseRI
+        if ph == Suspend then sus () else return ()
+    body =
+      do
+        evx <- lift $ lift $ sweepR
+        case evx
+          of
+            Event x ->
+              do
+                lift $ modify' (`mappend` outpre x)
+            NoEvent ->
+                return ()
+            End ->
+                breakCont False
 
+breakCont :: Monad m => r -> ContT r m a
+breakCont = ContT . const . return
 
+
 -- | Run a machine with results concatenated in terms of a monoid.
 runOn ::
     (ArrowApply a, Monoid r, Fd.Foldable f) =>
@@ -1318,31 +1310,27 @@
     ProcessA a (Event b) (Event c) ->
     a (f b) r
 runOn outpre pa0 = unArrowMonad $ \xs ->
-  do
-    wer <- runRM arrowMonad pa0 $ execWriterT $
+    runRM arrowMonad pa0 $ execStateT `flip` mempty $
       do
-        -- Sweep initial events.
-        (_, wer) <- listen $ sweepAll outpre
+        _ <- evalContT $
+          do
+            -- Sweep initial events.
+            sweepAll outpre
 
-        -- Feed inputs.
-        if getContWE wer
-          then
-            Fd.foldr feedSweep (return ()) xs
-          else
-            return ()
+            -- Feed values
+            mapM_ feedSweep xs
 
+            return True
+
         -- Terminate.
-        _ <- lift (feed_ End End)
-        sweepAll outpre
-    return $ getRWE wer
+        _ <- lift $ feed_ End End
+        evalContT $ sweepAll outpre >> return True
 
   where
-    feedSweep x cont =
+    feedSweep x =
       do
-        _ <- lift $ feedR x
-        ((), wer) <- listen $ sweepAll outpre
-        if getContWE wer then cont else return ()
-
+        _ <- lift $ lift $ feedR x
+        sweepAll outpre
 
 
 newtype Builder a = Builder {
@@ -1403,21 +1391,27 @@
     a b (ExecInfo [c], ProcessA a (Event b) (Event c))
 stepRun pa0 = unArrowMonad $ \x ->
   do
-    (pa, wer)  <- runRM arrowMonad pa0 $ runWriterT $
+    ((csmd, ct, pa), r)  <- runRM arrowMonad pa0 $ runStateT `flip` mempty $
       do
-        sweepAll singleton
-        _ <- lift $ feedR x
-        sweepAll singleton
-        lift $ freeze
-    return $ (retval wer, pa)
-
+        csmd <- evalContT $
+          do
+            sweepAll singleton
+            return True
+        ct <- evalContT $
+          do
+            _ <- lift $ lift $ feedR x
+            sweepAll singleton
+            return True
+        pa <- lift $ freeze
+        return (csmd, ct, pa)
+    return $ (retval r csmd ct, pa)
   where
     singleton x = Endo (x:)
 
-    retval WithEnd {..} = ExecInfo {
-        yields = appEndo getRWE [],
-        hasConsumed = True,
-        hasStopped = not getContWE
+    retval r csmd ct = ExecInfo {
+        yields = appEndo r [],
+        hasConsumed = csmd,
+        hasStopped = not ct
       }
 
 -- | Execute until an output produced.
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
@@ -54,6 +54,7 @@
         anytime,
         par,
         parB,
+        oneshot,
         now,
         onEnd,
 #if defined(MIN_VERSION_arrows)
@@ -311,14 +312,27 @@
 
 echo = filter (arr (const True))
 
-now ::
+-- |Emit an event of given value as soon as possible.
+oneshot ::
     ArrowApply a =>
-    ProcessA a b (Event ())
-now = arr (const noEvent) >>> go
+    c ->
+    ProcessA a b (Event c)
+oneshot x = arr (const noEvent) >>> go
   where
     go = construct $
-        yield () >> forever await
+        yield x >> forever await
 
+-- |Emit an event as soon as possible.
+--
+-- @
+--  now = oneshot ()
+-- @
+now ::
+    ArrowApply a =>
+    ProcessA a b (Event ())
+now = oneshot ()
+
+-- |Emit an event at the end of the input stream.
 onEnd ::
     (ArrowApply a, Occasional' b) =>
     ProcessA a b (Event ())
diff --git a/test/spec.hs b/test/spec.hs
--- a/test/spec.hs
+++ b/test/spec.hs
@@ -116,7 +116,18 @@
             in
               r1 == r2
 
+        it "is lazy for individual input values" $
+          do
+            let l = runOn (\x -> [x]) Cat.id (take 10 $ repeat undefined)
+            length l `shouldBe` 10
 
+{-
+        it "is lazy for inpurt stream" $
+          do
+            let l = take 10 $ run Cat.id (repeat undefined)
+            length l `shouldBe` 10
+-}
+
 rules =
   do
     describe "ProcessA as Category" $
@@ -354,6 +365,13 @@
 
 utility =
   do
+    describe "splitEvent" $
+      do
+        it "splits an event stream" $
+          do
+            run (splitEvent >>> arr fst) [Left 1, Right 2, Left 3, Right 4] `shouldBe` [1, 3]
+            run (splitEvent >>> arr snd) [Left 1, Right 2, Left 3, Right 4] `shouldBe` [2, 4]
+
     describe "edge" $
       do
         it "detects edges of input behaviour" $
@@ -411,7 +429,7 @@
             let
                 before = proc evx ->
                   do
-                    ch <- P.filter (arr $ (\x -> x `mod` 2 == 0)) -< evx
+                    ch <- P.filterEvent (\x -> x `mod` 2 == 0) -< evx
                     returnA -< (noEvent, ch)
 
                 after t = proc evx -> returnA -< (t*) <$> evx