diff --git a/Control/Monad/Operational/Mini.hs b/Control/Monad/Operational/Mini.hs
--- a/Control/Monad/Operational/Mini.hs
+++ b/Control/Monad/Operational/Mini.hs
@@ -50,8 +50,8 @@
 cloneProgram (Program m) = m return ((>>=) . elevate)
 
 instance Tower (Program t) where
-    type Floors (Program t) = t :> Empty
-    toLoft = simply $ \t -> Program $ \p i -> i t p
+    type Floors (Program t) = t :> ReifiedProgram t :> Empty
+    toLoft = (\t -> Program $ \p i -> i t p) ||> fromReified ||> exhaust
 
 -- | Reified version of 'Program'. It is useful for testing.
 data ReifiedProgram t a where
@@ -82,5 +82,5 @@
     (t :>>= m) >>= k = t :>>= (>>= k) . m
 
 instance Tower (ReifiedProgram t) where
-    type Floors (ReifiedProgram t) = t :> Empty
-    toLoft = simply (:>>= Return)
+    type Floors (ReifiedProgram t) = t :> Program t :> Empty
+    toLoft = (:>>= Return) ||> cloneProgram ||> exhaust
diff --git a/Control/Monad/Trans/Operational/Mini.hs b/Control/Monad/Trans/Operational/Mini.hs
--- a/Control/Monad/Trans/Operational/Mini.hs
+++ b/Control/Monad/Trans/Operational/Mini.hs
@@ -33,6 +33,7 @@
 import Control.Monad.Trans.Class
 import Control.Elevator
 import Data.OpenUnion1.Clean
+import qualified Control.Monad.Operational.Mini as P
 
 newtype ProgramT t m a = ProgramT
   { unProgramT :: forall r. (a -> r) -> (m r -> r) -> (forall x. t x -> (x -> r) -> r) -> r }
@@ -59,8 +60,16 @@
 interpret e (ProgramT m) = m return join (\t c -> e t >>= c)
 
 instance (Monad m, Tower m) => Tower (ProgramT t m) where
-    type Floors (ProgramT t m) = t :> Floors1 m
-    toLoft = (\t -> ProgramT $ \p _ i -> i t p) ||> lift . toLoft1
+    type Floors (ProgramT t m) = t
+      :> ReifiedProgramT t m
+      :> P.Program t
+      :> P.ReifiedProgram t
+      :> Floors1 m
+    toLoft = (\t -> ProgramT $ \p _ i -> i t p)
+      ||> fromReifiedT
+      ||> P.cloneProgram
+      ||> P.cloneProgram . P.fromReified
+      ||> lift . toLoft1
 
 instance MonadTrans (ProgramT t) where
     lift m = ProgramT $ \p l _ -> l (liftM p m)
@@ -110,7 +119,15 @@
     Lift a c >>= f = Lift a (c >=> f)
 
 instance (Monad m, Tower m) => Tower (ReifiedProgramT t m) where
-    type Floors (ReifiedProgramT t m) = t :> Floors1 m
-    toLoft = (:>>= Return) ||> lift . toLoft1
+    type Floors (ReifiedProgramT t m) = t
+      :> ProgramT t m
+      :> P.Program t
+      :> P.ReifiedProgram t
+      :> Floors1 m
+    toLoft = (:>>= Return)
+      ||> cloneProgramT
+      ||> P.cloneProgram
+      ||> P.cloneProgram . P.fromReified
+      ||> lift . toLoft1
 
 instance MonadTrans (ReifiedProgramT t) where lift = flip Lift Return
diff --git a/minioperational.cabal b/minioperational.cabal
--- a/minioperational.cabal
+++ b/minioperational.cabal
@@ -1,5 +1,5 @@
 name:                minioperational
-version:             0.4.7
+version:             0.4.8
 synopsis:            fast and simple operational monad
 description:         This package provides tiny implementation of operational monad.
 homepage:            https://github.com/fumieval/minioperational