diff --git a/Control/Monad/Butai.hs b/Control/Monad/Butai.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monad/Butai.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE Rank2Types, TemplateHaskell, GADTs, GeneralizedNewtypeDeriving, FlexibleContexts, FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses, TypeOperators #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Control.Monad.Butai (ButaiT, register, look, updateAll, Key(..), transButaiT, runButaiT) where
+
+import Data.Karakuri
+import Unsafe.Coerce
+import Control.Monad.Trans.Operational.Mini
+import Control.Monad.Operational.TH
+import Control.Monad.State.Class
+import Control.Monad.IO.Class
+import Control.Monad
+import Control.Applicative
+import qualified Data.IntMap as IM
+import Control.Comonad
+import Control.Monad.Trans.Class
+
+newtype Key a = Kao Int
+
+data ButaiBase m a where
+    Register :: Karakuri m r -> ButaiBase m (Key r)
+    Look :: Key r -> ButaiBase m r
+    UpdateAll :: ButaiBase m ()
+makeSingletons ''ButaiBase
+
+newtype ButaiT m a = ButaiT { unButaiT :: ReifiedProgramT (ButaiBase (ButaiT m)) m a } deriving (Monad, Applicative, Functor)
+
+
+instance MonadIO m => MonadIO (ButaiT m) where
+    liftIO = lift . liftIO
+
+instance MonadTrans ButaiT where
+    lift = ButaiT . lift
+
+instance Monad m => ButaiBase (ButaiT m) :! ButaiT m where
+    singleton = ButaiT . singleton
+
+instance MonadState s m => MonadState s (ButaiT m) where
+    get = lift get
+    put = lift . put
+
+transButaiBase :: (forall a. m a -> n a) -> ButaiBase m a -> ButaiBase n a
+transButaiBase t (Register k) = Register (transKarakuri t k)
+transButaiBase _ (Look k) = Look k
+transButaiBase _ UpdateAll = UpdateAll
+
+transButaiT :: (Monad m, Monad n) => (forall x. m x -> n x) -> ButaiT m a -> ButaiT n a
+transButaiT t = ButaiT . hoistReifiedT (transButaiBase (transButaiT t)) . transReifiedT t . unButaiT
+
+data Any
+
+runButaiT :: forall m a. Monad m => ButaiT m a -> m a
+runButaiT = go 0 IM.empty . unButaiT where
+    go :: Int -> IM.IntMap (Karakuri (ButaiT m) Any) -> ReifiedProgramT (ButaiBase (ButaiT m)) m a -> m a
+    go i m (Register k :>>= cont) = go (succ i) (IM.insert i (unsafeCoerce k) m) $ cont (Kao i)
+    go i m (Look k@(Kao j) :>>= cont) = go i m $ cont $ extract (unsafeCoerce (m IM.! j) `asKarakuriOf` k)
+    go i m (UpdateAll :>>= cont) = do
+        rs <- runButaiT $ forM (IM.toAscList m) (\(i, m) -> (,) i `liftM` step m)
+        go i (IM.fromAscList rs) (cont ())
+    go i m (Lift a cont) = a >>= go i m . cont
+    go _ _ (Return a) = return a
+
+    asKarakuriOf :: Karakuri m x -> p x -> Karakuri m x
+    asKarakuriOf x _ = x
diff --git a/Data/Karakuri.hs b/Data/Karakuri.hs
--- a/Data/Karakuri.hs
+++ b/Data/Karakuri.hs
@@ -1,63 +1,63 @@
-{-# LANGUAGE ExistentialQuantification, Rank2Types #-}
-
-module Data.Karakuri (
-    Karakuri(..)
-    , Karakuri'
-    , step
-    , transKarakuri
-    , stateful
-    , stateful'
-    , effective
-    ) where
-
-import Control.Monad.Trans.State
-import Control.Applicative
-import Control.Comonad
-import Data.Functor.Identity
-import Control.Monad
-
--- | Karakuri means automaton in Japanese.
-data Karakuri m a = forall s. Karakuri (s -> m s) (s -> a) s
-
--- | Run a 'Karakuri'.
-step :: Monad m => Karakuri m a -> m (Karakuri m a)
-step (Karakuri m f s) = Karakuri m f `liftM` m s
-
-instance Functor (Karakuri m) where
-    fmap f (Karakuri m g s) = Karakuri m (f . g) s
-    {-# INLINE fmap #-}
-
-instance Monad m => Applicative (Karakuri m) where
-    pure a = Karakuri return (const a) ()
-    {-# INLINE pure #-}
-    Karakuri m f s <*> Karakuri n g t = Karakuri
-        (\(a, b) -> m a >>= \r -> n b >>= \s -> return (r, s))
-        (\(x, y) -> f x (g y))
-        (s, t)
-
-instance Comonad (Karakuri m) where
-    extract (Karakuri _ f s) = f s
-    {-# INLINE extract #-}
-    extend k (Karakuri m f s) = Karakuri m (k . Karakuri m f) s
-    {-# INLINE extend #-}
-
-instance Monad m => ComonadApply (Karakuri m) where
-    (<@>) = (<*>)
-    {-# INLINE (<@>) #-}
-
-transKarakuri :: (forall s. m s -> n s) -> Karakuri m a -> Karakuri n a
-transKarakuri t (Karakuri f e s) = Karakuri (t . f) e s
-
--- | Create a 'Karakuri' from the stateful action.
-stateful :: Monad m => StateT s m () -> s -> Karakuri m s
-stateful m s = Karakuri (execStateT m) id s
-
-type Karakuri' = Karakuri Identity
-
--- | Create a 'Karakuri' from the stateful action.
-stateful' :: Monad m => State s () -> s -> Karakuri m s
-stateful' m s = Karakuri (return . execState m) id s
-
--- | Create a 'Karakuri' that performs the given action every time.
-effective :: Monad m => a -> m a -> Karakuri m a
-effective a m = Karakuri (const m) id a
+{-# LANGUAGE ExistentialQuantification, Rank2Types #-}
+
+module Data.Karakuri (
+    Karakuri(..)
+    , Karakuri'
+    , step
+    , transKarakuri
+    , stateful
+    , stateful'
+    , effective
+    ) where
+
+import Control.Monad.Trans.State
+import Control.Applicative
+import Control.Comonad
+import Data.Functor.Identity
+import Control.Monad
+
+-- | Karakuri means automaton in Japanese.
+data Karakuri m a = forall s. Karakuri (s -> m s) (s -> a) s
+
+-- | Run a 'Karakuri'.
+step :: Monad m => Karakuri m a -> m (Karakuri m a)
+step (Karakuri m f s) = Karakuri m f `liftM` m s
+
+instance Functor (Karakuri m) where
+    fmap f (Karakuri m g s) = Karakuri m (f . g) s
+    {-# INLINE fmap #-}
+
+instance Monad m => Applicative (Karakuri m) where
+    pure a = Karakuri return (const a) ()
+    {-# INLINE pure #-}
+    Karakuri m f s <*> Karakuri n g t = Karakuri
+        (\(a, b) -> m a >>= \r -> n b >>= \s -> return (r, s))
+        (\(x, y) -> f x (g y))
+        (s, t)
+
+instance Comonad (Karakuri m) where
+    extract (Karakuri _ f s) = f s
+    {-# INLINE extract #-}
+    extend k (Karakuri m f s) = Karakuri m (k . Karakuri m f) s
+    {-# INLINE extend #-}
+
+instance Monad m => ComonadApply (Karakuri m) where
+    (<@>) = (<*>)
+    {-# INLINE (<@>) #-}
+
+transKarakuri :: (forall s. m s -> n s) -> Karakuri m a -> Karakuri n a
+transKarakuri t (Karakuri f e s) = Karakuri (t . f) e s
+
+-- | Create a 'Karakuri' from the stateful action.
+stateful :: Monad m => StateT s m () -> s -> Karakuri m s
+stateful m s = Karakuri (execStateT m) id s
+
+type Karakuri' = Karakuri Identity
+
+-- | Create a 'Karakuri' from the stateful action.
+stateful' :: Monad m => State s () -> s -> Karakuri m s
+stateful' m s = Karakuri (return . execState m) id s
+
+-- | Create a 'Karakuri' that performs the given action every time.
+effective :: Monad m => a -> m a -> Karakuri m a
+effective a m = Karakuri (const m) id a
diff --git a/karakuri.cabal b/karakuri.cabal
--- a/karakuri.cabal
+++ b/karakuri.cabal
@@ -1,22 +1,22 @@
-name:                karakuri
-version:             0.1
-synopsis:            Good stateful automata 
--- description:         
-homepage:            https://github.com/fumieval/karakuri
-license:             BSD3
-license-file:        LICENSE
-author:              Fumiaki Kinoshita
-maintainer:          fumiexcel@gmail.com
-copyright:           Copyright (C) 2013 Fumiaki Kinoshita
-category:            Data
-build-type:          Simple
--- extra-source-files:  
-cabal-version:       >=1.10
-
-library
-  exposed-modules:     Data.Karakuri
-  -- other-modules:       
-  other-extensions:    ExistentialQuantification, Rank2Types
-  build-depends:       base == 4.*, transformers >=0.3 && <0.4, comonad == 3.*
-  -- hs-source-dirs:      
+name:                karakuri
+version:             0.1.1
+synopsis:            Good stateful automata 
+-- description:         
+homepage:            https://github.com/fumieval/karakuri
+license:             BSD3
+license-file:        LICENSE
+author:              Fumiaki Kinoshita
+maintainer:          fumiexcel@gmail.com
+copyright:           Copyright (C) 2013 Fumiaki Kinoshita
+category:            Data
+build-type:          Simple
+-- extra-source-files:  
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Data.Karakuri, Control.Monad.Butai
+  -- other-modules:       
+  other-extensions:    ExistentialQuantification, Rank2Types
+  build-depends:       base == 4.*, transformers >=0.3 && <0.4, comonad == 3.*, mtl == 2.*, containers, minioperational == 0.4.*
+  -- hs-source-dirs:      
   default-language:    Haskell2010