diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,7 @@
+0.6.5
+----
+* Supported `elevator >= 0.2`.
+
 0.6.3.1
 ----
 * Reverted the fixity.
diff --git a/objective.cabal b/objective.cabal
--- a/objective.cabal
+++ b/objective.cabal
@@ -1,5 +1,5 @@
 name:                objective
-version:             0.6.3.3
+version:             0.6.5
 synopsis:            Extensible objects
 description:         Stateful effect transducer
 homepage:            https://github.com/fumieval/objective
@@ -33,8 +33,8 @@
   other-extensions:    MultiParamTypeClasses, KindSignatures, TypeFamilies
   build-depends:       base >=4.5 && <5
     , comonad
-    , clean-unions < 0.2
-    , elevator >= 0.1.2 && <0.2
+    , elevator >= 0.2 && <0.3
+    , extensible
     , containers
     , minioperational >= 0.4 && <0.5
     , profunctors >= 4.0 && <5
diff --git a/src/Control/Monad/Objective/Class.hs b/src/Control/Monad/Objective/Class.hs
--- a/src/Control/Monad/Objective/Class.hs
+++ b/src/Control/Monad/Objective/Class.hs
@@ -25,6 +25,7 @@
 import Control.Elevator
 import Control.Monad.Trans.State.Strict
 import Control.Monad.Operational.Mini
+import Data.Functor.Identity
 import Control.Monad
 
 type Inst' f g = Inst g f g
@@ -38,6 +39,9 @@
 
 type MonadObjective b m = (ObjectiveBase b, Elevate b m, Monad m)
 
+(.->) :: (Monad m, ObjectiveBase m) => Inst m f m -> f a -> m a
+(.->) = invoke id id
+
 (.-) :: (MonadObjective b m, Elevate g m) => Inst b f g -> f a -> m a
 (.-) = invoke elevate elevate
 {-# INLINE (.-) #-}
@@ -53,10 +57,9 @@
 -- | (.^) for StateT
 (.&) :: (MonadObjective b m, Elevate g m, Elevate (State s) f) => Inst b f g -> StateT s m a -> m a
 i .& m = do
-  s <- i .^ get
+  s <- i .^ StateT (\s -> Identity (s, s))
   (a, s') <- runStateT m s
-  i .^ put s'
-  return a
+  i .^ StateT (\_ -> Identity (a, s'))
 
 infixr 3 .&
 
diff --git a/src/Control/Object/Extra.hs b/src/Control/Object/Extra.hs
--- a/src/Control/Object/Extra.hs
+++ b/src/Control/Object/Extra.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE Rank2Types, TypeOperators, FlexibleContexts, ConstraintKinds #-}
 module Control.Object.Extra where
 import Control.Object.Object
-import Control.Object.Mortal
 import qualified Data.HashMap.Strict as HM
 import qualified Data.Map.Strict as Map
 import Data.Witherable
@@ -10,14 +9,15 @@
 import Control.Monad.Trans.State.Strict
 import Control.Monad.Trans.Class
 import Control.Monad
-import Control.Elevator
 import Data.Functor.Request
 import Data.Functor.PushPull
 import Control.Applicative
-import Data.OpenUnion1.Clean
 import Data.Monoid
 import Data.Hashable
 import Data.Traversable as T
+import Data.IORef
+import Data.Profunctor.Unsafe
+import Control.Monad.IO.Class
 
 -- | Build an object using continuation passing style.
 oneshot :: (Functor f, Monad m) => (forall a. f (m a) -> m a) -> Object f m
@@ -31,6 +31,7 @@
   go m = Object $ \(Request k cont) -> case Map.lookup k m of
     Just a -> return (cont a, go m)
     Nothing -> f k >>= \a -> return (cont a, go $ Map.insert k a m)
+{-# INLINE flyweight #-}
 
 -- | Like 'flyweight', but it uses 'Data.HashMap.Strict' internally.
 flyweight' :: (Monad m, Eq k, Hashable k) => (k -> m a) -> Object (Request k a) m
@@ -38,60 +39,38 @@
   go m = Object $ \(Request k cont) -> case HM.lookup k m of
     Just a -> return (cont a, go m)
     Nothing -> f k >>= \a -> return (cont a, go $ HM.insert k a m)
+{-# INLINE flyweight' #-}
 
 animate :: (Applicative m, Num t) => (t -> m a) -> Object (Request t a) m
 animate f = go 0 where
   go t = Object $ \(Request dt cont) -> (\x -> (cont x, go (t + dt))) <$> f t
+{-# INLINE animate #-}
 
 transit :: (Alternative m, Fractional t, Ord t) => t -> (t -> m a) -> Object (Request t a) m
 transit len f = go 0 where
   go t
     | t >= len = Object $ const empty
     | otherwise = Object $ \(Request dt cont) -> (\x -> (cont x, go (t + dt))) <$> f (t / len)
+{-# INLINE transit #-}
 
-announce :: (T.Traversable t, Monad m, Elevate (State (t (Object f g))) m, Elevate g m) => f a -> m [a]
-announce f = do
-  t <- elevate get
-  (t', Endo e) <- runWriterT $ T.mapM (\obj -> (lift . elevate) (runObject obj f)
+announce :: (T.Traversable t, Monad m) => f a -> StateT (t (Object f m)) m [a]
+announce f = StateT $ \t -> do
+  (t', Endo e) <- runWriterT $ T.mapM (\obj -> lift (runObject obj f)
       >>= \(x, obj') -> writer (obj', Endo (x:))) t
-  elevate (put t')
-  return (e [])
+  return (e [], t')
 
-announceMaybe :: (Witherable t
-    , Monad m
-    , Elevate (State (t (Object f Maybe))) m) => f a -> m [a]
-announceMaybe f = elevate $ state
+announceMaybe :: (Witherable t, Monad m) => f a -> StateT (t (Object f Maybe)) m [a]
+announceMaybe f = StateT
   $ \t -> let (t', Endo e) = runWriter
                 $ witherM (\obj -> case runObject obj f of
                   Just (x, obj') -> lift $ writer (obj', Endo (x:))
-                  Nothing -> mzero) t in (e [], t')
-
-announceMaybeT :: (Witherable t
-  , Monad m
-  , State (t (Object f (MaybeT g))) ∈ Floors1 m
-  , g ∈ Floors1 m
-  , Tower m) => f a -> m [a]
-announceMaybeT f = do
-  t <- elevate get
-  (t', Endo e) <- runWriterT $ witherM (\obj -> mapMaybeT (lift . elevate) (runObject obj f)
-      >>= \(x, obj') -> lift (writer (obj', Endo (x:)))) t
-  elevate (put t')
-  return (e [])
+                  Nothing -> mzero) t in return (e [], t')
 
-announceMortal :: (Witherable t
-  , Monad m
-  , State (t (Mortal f g ())) ∈ Floors1 m
-  , g ∈ Floors1 m
-  , Tower m) => f a -> m [a]
-announceMortal f = do
-  t <- elevate get
-  (t', Endo e) <- runWriterT $ witherM (\obj -> MaybeT (lift $ liftM is $ elevate $ runMortal obj f)
+announceMaybeT :: (Witherable t, Monad m) => f a -> StateT (t (Object f (MaybeT m))) m [a]
+announceMaybeT f = StateT $ \t -> do
+  (t', Endo e) <- runWriterT $ witherM (\obj -> mapMaybeT lift (runObject obj f)
       >>= \(x, obj') -> lift (writer (obj', Endo (x:)))) t
-  elevate (put t')
-  return (e [])
-  where
-    is (Left ()) = Nothing
-    is (Right a) = Just a
+  return (e [], t')
 
 type Variable s = forall m. Monad m => Object (StateT s m) m
 
@@ -112,3 +91,14 @@
     Push a c -> let z = f a r in pure (c, z `seq` go z)
     Pull cont -> pure (cont r, go r)
 {-# INLINE foldPP #-}
+
+(*-) :: MonadIO m => IORef (Object f m) -> f a -> m a
+r *- f = do
+  obj <- liftIO $ readIORef r
+  (a, obj') <- runObject obj f
+  liftIO $ writeIORef r obj'
+  return a
+
+invoke :: f a -> StateT (Object f m) m a
+invoke = StateT #. flip runObject
+{-# INLINE invoke #-}
diff --git a/src/Control/Object/Mortal.hs b/src/Control/Object/Mortal.hs
--- a/src/Control/Object/Mortal.hs
+++ b/src/Control/Object/Mortal.hs
@@ -5,6 +5,7 @@
     mortal,
     mortal_,
     runMortal,
+    runMortal',
     immortal,
     reincarnation
     ) where
@@ -35,18 +36,22 @@
 instance Monad m => Monad (Mortal f m) where
   return a = mortal $ const $ left a
   {-# INLINE return #-}
-  m >>= k = mortal $ \f -> lift (runMortal m f) >>= \r -> case r of
-    Left a -> EitherT $ runMortal (k a) f
+  m >>= k = mortal $ \f -> lift (runMortal' m f) >>= \r -> case r of
+    Left a -> runMortal (k a) f
     Right (x, m') -> return (x, m' >>= k)
 
 mortal :: (forall x. f x -> EitherT a m (x, Mortal f m a)) -> Mortal f m a
-mortal f = unsafeCoerce f
+mortal f = Mortal (Object (fmap unsafeCoerce f))
 {-# INLINE mortal #-}
 
-runMortal :: Mortal f m a -> f x -> m (Either a (x, Mortal f m a))
+runMortal :: Mortal f m a -> f x -> EitherT a m (x, Mortal f m a)
 runMortal = unsafeCoerce
 {-# INLINE runMortal #-}
 
+runMortal' :: Mortal f m a -> f x -> m (Either a (x, Mortal f m a))
+runMortal' = unsafeCoerce
+{-# INLINE runMortal' #-}
+
 -- | Restricted 'Mortal' constuctor, which can be applied to 'transit', 'fromFoldable' without ambiguousness.
 mortal_ :: Object f (EitherT () g) -> Mortal f g ()
 mortal_ = Mortal
@@ -56,7 +61,8 @@
 immortal obj = mortal $ \f -> EitherT $ runObject obj f >>= \(a, obj') -> return $ Right (a, immortal obj')
 
 reincarnation :: Monad m => (a -> Mortal f m a) -> a -> Object f m
-reincarnation g a0 = go (g a0) where
-  go m = Object $ \f -> runMortal m f >>= \r -> case r of
+reincarnation g = go . g where
+  go m = Object $ \f -> runMortal' m f >>= \r -> case r of
     Left a -> runObject (go (g a)) f
     Right (a, m') -> return (a, go m')
+{-# INLINE reincarnation #-}
diff --git a/src/Control/Object/Object.hs b/src/Control/Object/Object.hs
--- a/src/Control/Object/Object.hs
+++ b/src/Control/Object/Object.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE Rank2Types, CPP, TypeOperators #-}
+{-# LANGUAGE Rank2Types, CPP, TypeOperators, DataKinds #-}
 #if __GLASGOW_HASKELL__ >= 707
 {-# LANGUAGE DeriveDataTypeable #-}
 #endif
@@ -12,9 +12,10 @@
 import qualified Control.Monad.Trans.Free as T
 import qualified Control.Monad.Trans.Operational.Mini as T
 import Control.Monad.Trans.State.Strict
-import Data.OpenUnion1.Clean
 import Data.Typeable
 import Control.Applicative
+import Data.Extensible
+import Control.Arrow (first)
 
 -- | The type @Object f g@ represents objects which can handle messages @f@, perform actions in the environment @g@.
 -- It can be thought of as an automaton that converts effects.
@@ -72,7 +73,7 @@
 -- @stateful t s = t ^>>@ variable s@
 stateful :: Monad m => (forall a. f a -> StateT s m a) -> s -> Object f m
 stateful h = go where
-  go s = Object $ liftM (\(a, s') -> (a, go s')) . flip runStateT s . h
+  go s = Object $ \f -> runStateT (h f) s >>= \(a, s') -> s' `seq` return (a, go s')
 {-# INLINE stateful #-}
 
 -- | Object-object composition
@@ -86,7 +87,6 @@
 {-# INLINE (@<<@) #-}
 infixl 1 @<<@
 
-
 -- | Object-function composition
 (@>>^) :: Functor h => Object f g -> (forall x. g x -> h x) -> Object f h
 m0 @>>^ g = go m0 where go (Object m) = Object $ fmap (fmap go) . g . m
@@ -109,22 +109,13 @@
   Right g -> fmap (fmap (a@||@)) (runObject b g)
 infixr 2 @||@
 
--- | An object that won't accept any messages.
-loner :: Functor f => Object Nil f
-loner = liftO exhaust
-
--- | Extend an object by another independent object.
-(@|>@) :: Functor g => Object f g -> Object (Union s) g -> Object (f |> Union s) g
-p @|>@ q = Object $ fmap (fmap (@|>@q)) . runObject p ||> fmap (fmap (p @|>@)) . runObject q
-infixr 3 @|>@
-
 -- | Build a stateful object, sharing out the state.
-sharing :: Monad m => (forall a. f a -> StateT s m a) -> s -> Object (State s |> f |> Nil) m
+sharing :: Monad m => (forall a. f a -> StateT s m a) -> s -> Object (Union '[State s, f]) m
 sharing m = go where
-  go s = Object $ \k -> liftM (fmap go) $ ($k)
-    $ (\n -> return $ runState n s)
-    ||> (\e -> runStateT (m e) s)
-    ||> exhaust
+  go s = Object $ \k -> liftM (fmap go) $ caseOf (getUnion k)
+    $ (\n cont -> return $ first cont $ runState n s)
+    <$?~ (\e cont -> first cont `liftM` runStateT (m e) s)
+    <$?~ Nil
 {-# INLINE sharing #-}
 
 (@!) :: Monad m => Object e m -> ReifiedProgram e a -> m (a, Object e m)
diff --git a/src/Data/Functor/PushPull.hs b/src/Data/Functor/PushPull.hs
--- a/src/Data/Functor/PushPull.hs
+++ b/src/Data/Functor/PushPull.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE DeriveFunctor, DeriveDataTypeable, ConstraintKinds, FlexibleContexts, DataKinds, TypeFamilies, TypeOperators #-}
+{-# LANGUAGE ScopedTypeVariables, Rank2Types, DeriveFunctor, DeriveDataTypeable, ConstraintKinds, FlexibleContexts, DataKinds, TypeFamilies, TypeOperators #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Functor.PushPull
@@ -14,10 +14,10 @@
 module Data.Functor.PushPull where
 import Data.Typeable
 import Control.Elevator
-import Data.OpenUnion1.Clean
 import Control.Applicative
 import Data.Profunctor
 import Data.Functor.Day
+import Data.Extensible
 
 -- | The type for asynchronous input/output.
 data PushPull a b r = Push a r | Pull (b -> r) deriving (Functor, Typeable)
@@ -29,18 +29,18 @@
   dimap f g (Pull br) = Pull (dimap f g br)
 
 instance Tower (PushPull a b) where
-  type Floors (PushPull a b) = (,) a :> (->) b :> Empty
-  toLoft = uncurry Push ||> Pull ||> exhaust
+  type Floors (PushPull a b) = '[(,) a, (->) b]
+  stairs = uncurry Push `rung` Pull `rung` Nil
 
+push :: Elevate ((,) a) f => a -> f ()
+push a = elevate (a, ())
+
+pull :: Elevate ((->) a) f => f a
+pull = elevate id
+
 mapPush :: (a -> a') -> PushPull a b r -> PushPull a' b r
 mapPush f (Push a r) = Push (f a) r
 mapPush _ (Pull br) = Pull br
-
-push :: (Elevate (PushPull a b) f) => a -> f ()
-push a = elevate (Push a ())
-
-pull :: (Elevate (PushPull a b) f) => f b
-pull = elevate (Pull id)
 
 bipush :: (i -> (a, c)) -> (b -> d -> o) -> PushPull i o r -> Day (PushPull a b) (PushPull c d) r
 bipush f g = go where
diff --git a/src/Data/Functor/Request.hs b/src/Data/Functor/Request.hs
--- a/src/Data/Functor/Request.hs
+++ b/src/Data/Functor/Request.hs
@@ -14,10 +14,10 @@
 module Data.Functor.Request where
 import Data.Typeable
 import Control.Elevator
+import Data.Extensible
 import Control.Monad
 import Data.Monoid
 import Control.Applicative
-import Data.OpenUnion1.Clean
 import Data.Profunctor
 
 -- | 'Request a b' is the type of a request that sends @a@ to receive @b@.
@@ -36,8 +36,8 @@
   Request a c <*> Request b d = Request (mappend a b) (c <*> d)
 
 instance Tower (Request a b) where
-  type Floors (Request a b) = Empty
-  toLoft = exhaust
+  type Floors (Request a b) = '[]
+  stairs = Nil
 
 request :: (Elevate (Request a b) f) => a -> f b
 request a = elevate (Request a id)