diff --git a/extensible-effects.cabal b/extensible-effects.cabal
--- a/extensible-effects.cabal
+++ b/extensible-effects.cabal
@@ -6,7 +6,7 @@
 -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             2.5.0.0
+version:             2.5.1.0
 
 -- A short (one-line) description of the package.
 synopsis:            An Alternative to Monad Transformers
@@ -88,7 +88,8 @@
                        Data.OpenUnion
 
   -- Modules included in this library but not exported.
-  other-modules:       Data.FTCQueue
+  other-modules:       Control.Eff.Internal
+                       Data.FTCQueue
   if flag(force-openunion-51)
     cpp-options:       -DFORCE_OU51
 
@@ -134,10 +135,10 @@
 
   -- Other library packages from which modules are imported.
   build-depends:       base >= 4.7 && < 4.11
-                       -- For MonadIO instance
-                       , transformers >= 0.3 && < 0.6
-                       -- For MonadBase instance
-                       , transformers-base == 0.4.*
+                       -- For MonadBase
+               ,       transformers-base == 0.4.*
+                       -- For MonadBaseControl
+               ,       monad-control >= 1.0 && < 1.1
 
   -- Directories containing source files.
   hs-source-dirs:      src
@@ -184,6 +185,7 @@
                 base >= 4.7 && < 4.11
               , QuickCheck
               , HUnit
+              , monad-control >= 1.0
               , silently >= 1.2
               , test-framework == 0.8.*
               , test-framework-hunit == 0.3.*
diff --git a/src/Control/Eff.hs b/src/Control/Eff.hs
--- a/src/Control/Eff.hs
+++ b/src/Control/Eff.hs
@@ -1,228 +1,6 @@
-{-# OPTIONS_GHC -Werror #-}
-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE DataKinds #-}
-
-{-# LANGUAGE CPP #-}
-
--- ------------------------------------------------------------------------
--- | A monadic library for communication between a handler and
--- its client, the administered computation
---
--- Original work available at <http://okmij.org/ftp/Haskell/extensible/tutorial.html>.
--- This module implements extensible effects as an alternative to monad transformers,
--- as described in <http://okmij.org/ftp/Haskell/extensible/exteff.pdf> and
--- <http://okmij.org/ftp/Haskell/extensible/more.pdf>.
---
--- Extensible Effects are implemented as typeclass constraints on an Eff[ect] datatype.
--- A contrived example can be found under "Control.Eff.Example". To run the
--- effects, consult the tests.
-module Control.Eff (
-  module Control.Eff
-  , module Data.OpenUnion
-  ) where
-
-#if __GLASGOW_HASKELL__ < 710
-import Control.Applicative
-#endif
-import qualified Control.Arrow as A
-import qualified Control.Category as C
-import safe Data.OpenUnion
-import safe Data.FTCQueue
-import GHC.Exts (inline)
-
--- | Effectful arrow type: a function from a to b that also does effects
--- denoted by r
-type Arr r a b = a -> Eff r b
-
--- | An effectful function from 'a' to 'b' that is a composition of one or more
--- effectful functions. The paremeter r describes the overall effect.
---
--- The composition members are accumulated in a type-aligned queue.
--- Using a newtype here enables us to define `Category' and `Arrow' instances.
-newtype Arrs r a b = Arrs (FTCQueue (Eff r) a b)
-
--- | 'Arrs' can be composed and have a natural identity.
-instance C.Category (Arrs r) where
-  id = ident
-  f . g = comp g f
-
--- | As the name suggests, 'Arrs' also has an 'Arrow' instance.
-instance A.Arrow (Arrs r) where
-  arr = arr
-  first = singleK . first . (^$)
-
-first :: Arr r a b -> Arr r (a, c) (b, c)
-first x = \(a,c) -> (, c) `fmap` x a
-
--- | convert single effectful arrow into composable type. i.e., convert 'Arr' to
--- 'Arrs'
-{-# INLINE singleK #-}
-singleK :: Arr r a b -> Arrs r a b
-singleK = Arrs . tsingleton
-
--- | Application to the `generalized effectful function' Arrs r b w, i.e.,
--- convert 'Arrs' to 'Arr'
-{-# INLINABLE qApp #-}
-qApp :: forall r b w. Arrs r b w -> Arr r b w
-qApp (Arrs q) x = viewlMap (inline tviewl q) ($ x) cons
-  where
-    cons :: forall x. Arr r b x -> FTCQueue (Eff r) x w -> Eff r w
-    cons = \k t -> case k x of
-      Val y -> qApp (Arrs t) y
-      E u (Arrs q0) -> E u (Arrs (q0 >< t))
-{-
--- A bit more understandable version
-qApp :: Arrs r b w -> b -> Eff r w
-qApp q x = case tviewl q of
-   TOne k  -> k x
-   k :| t -> bind' (k x) t
- where
-   bind' :: Eff r a -> Arrs r a b -> Eff r b
-   bind' (Pure y) k     = qApp k y
-   bind' (Impure u q) k = Impure u (q >< k)
--}
-
--- | Syntactic sugar for 'qApp'
-{-# INLINABLE (^$) #-}
-(^$) :: forall r b w. Arrs r b w -> Arr r b w
-q ^$ x = q `qApp` x
-
--- | Lift a function to an arrow
-arr :: (a -> b) -> Arrs r a b
-arr f = singleK (Val . f)
-
--- | The identity arrow
-ident :: Arrs r a a
-ident = arr id
-
--- | Arrow composition
-comp :: Arrs r a b -> Arrs r b c -> Arrs r a c
-comp (Arrs f) (Arrs g) = Arrs (f >< g)
-
--- | Common pattern: append 'Arr' to 'Arrs'
-(^|>) :: Arrs r a b -> Arr r b c -> Arrs r a c
-(Arrs f) ^|> g = Arrs (f |> g)
-
--- | The Eff monad (not a transformer!). It is a fairly standard coroutine monad
--- where the type @r@ is the type of effects that can be handled, and the
--- missing type @a@ (from the type application) is the type of value that is
--- returned.  It is NOT a Free monad! There are no Functor constraints.
---
--- The two constructors denote the status of a coroutine (client): done with the
--- value of type a, or sending a request of type Union r with the continuation
--- Arrs r b a. Expressed another way: an `Eff` can either be a value (i.e.,
--- 'Val' case), or an effect of type @`Union` r@ producing another `Eff` (i.e.,
--- 'E' case). The result is that an `Eff` can produce an arbitrarily long chain
--- of @`Union` r@ effects, terminated with a pure value.
---
--- Potentially, inline Union into E
-data Eff r a = Val a
-             | forall b. E  (Union r b) (Arrs r b a)
-
--- | Compose effectful arrows (and possibly change the effect!)
-{-# INLINE qComp #-}
-qComp :: Arrs r a b -> (Eff r b -> Eff r' c) -> Arr r' a c
--- qComp g h = (h . (g `qApp`))
-qComp g h = \a -> h $ (g ^$ a)
-
--- | Compose effectful arrows (and possibly change the effect!)
-{-# INLINE qComps #-}
-qComps :: Arrs r a b -> (Eff r b -> Eff r' c) -> Arrs r' a c
-qComps g h = singleK $ qComp g h
-
--- | Eff is still a monad and a functor (and Applicative)
--- (despite the lack of the Functor constraint)
-instance Functor (Eff r) where
-  {-# INLINE fmap #-}
-  fmap f (Val x) = Val (f x)
-  fmap f (E u q) = E u (q ^|> (Val . f)) -- does no mapping yet!
-
-instance Applicative (Eff r) where
-  {-# INLINE pure #-}
-  pure = Val
-  Val f <*> e = f `fmap` e
-  E u q <*> e = E u (q ^|> (`fmap` e))
-
-instance Monad (Eff r) where
-  {-# INLINE return #-}
-  {-# INLINE [2] (>>=) #-}
-  return = pure
-  Val x >>= k = k x
-  E u q >>= k = E u (q ^|> k)          -- just accumulates continuations
-{-
-  Val _ >> m = m
-  E u q >> m = E u (q ^|> const m)
--}
-
--- | Send a request and wait for a reply (resulting in an effectful
--- computation).
-{-# INLINE [2] send #-}
-send :: Member t r => t v -> Eff r v
-send t = E (inj t) (singleK Val)
--- This seems to be a very beneficial rule! On micro-benchmarks, cuts
--- the needed memory in half and speeds up almost twice.
-{-# RULES
-  "send/bind" [~3] forall t k. send t >>= k = E (inj t) (singleK k)
- #-}
-
-
--- ------------------------------------------------------------------------
--- | The initial case, no effects. Get the result from a pure computation.
---
--- The type of run ensures that all effects must be handled:
--- only pure computations may be run.
-run :: Eff '[] w -> w
-run (Val x) = x
--- | the other case is unreachable since Union [] a cannot be
--- constructed.
--- Therefore, run is a total function if its argument terminates.
-run (E _ _) = error "extensible-effects: the impossible happened!"
-
--- | A convenient pattern: given a request (open union), either
--- handle it or relay it.
-{-# INLINE handle_relay #-}
-handle_relay :: (a -> Eff r w) ->
-                (forall v. t v -> Arr r v w -> Eff r w) ->
-                Eff (t ': r) a -> Eff r w
-handle_relay ret h m = loop m
- where
-  loop (Val x)  = ret x
-  loop (E u q)  = case decomp u of
-    Right x -> h x k
-    Left  u0 -> E u0 (singleK k)
-   where k = qComp q loop
-
--- | Parameterized handle_relay
-{-# INLINE handle_relay_s #-}
-handle_relay_s :: s ->
-                (s -> a -> Eff r w) ->
-                (forall v. s -> t v -> (s -> Arr r v w) -> Eff r w) ->
-                Eff (t ': r) a -> Eff r w
-handle_relay_s s ret h m = loop s m
-  where
-    loop s0 (Val x)  = ret s0 x
-    loop s0 (E u q)  = case decomp u of
-      Right x -> h s0 x k
-      Left  u0 -> E u0 (singleK (k s0))
-     where k s1 x = loop s1 $ qApp q x
+module Control.Eff ( module Internal
+                   , module OpenUnion
+                   ) where
 
--- | Add something like Control.Exception.catches? It could be useful
--- for control with cut.
---
--- Intercept the request and possibly reply to it, but leave it unhandled
--- (that's why we use the same r all throuout)
-{-# INLINE interpose #-}
-interpose :: Member t r =>
-             (a -> Eff r w) -> (forall v. t v -> Arr r v w -> Eff r w) ->
-             Eff r a -> Eff r w
-interpose ret h m = loop m
- where
-   loop (Val x)  = ret x
-   loop (E u q)  = case prj u of
-     Just x -> h x k
-     _      -> E u (singleK k)
-    where k = qComp q loop
+import Control.Eff.Internal as Internal hiding (Lift(..), lift, runLift)
+import Data.OpenUnion as OpenUnion
diff --git a/src/Control/Eff/Choose.hs b/src/Control/Eff/Choose.hs
--- a/src/Control/Eff/Choose.hs
+++ b/src/Control/Eff/Choose.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -18,11 +19,14 @@
                           , mplus'
                           ) where
 
-import Control.Eff
+import Control.Eff.Internal
+import Data.OpenUnion
 #if __GLASGOW_HASKELL__ > 708
 import Control.Applicative
-import Control.Monad
 #endif
+import Control.Monad
+import Control.Monad.Base
+import Control.Monad.Trans.Control
 
 -- ------------------------------------------------------------------------
 -- | Non-determinism (choice)
@@ -34,6 +38,16 @@
 -- any constraints.
 newtype Choose a = Choose [a]
 
+instance ( MonadBase m m
+         , SetMember Lift (Lift m) r
+         , MonadBaseControl m (Eff r)
+         ) => MonadBaseControl m (Eff (Choose ': r)) where
+    type StM (Eff (Choose ': r)) a = StM (Eff r) [a]
+    liftBaseWith f = raise $ liftBaseWith $ \runInBase ->
+                       f (runInBase . makeChoice)
+    restoreM x = do lst <- raise (restoreM x)
+                    choose lst
+
 -- | choose lst non-deterministically chooses one value from the lst
 -- choose [] thus corresponds to failure
 choose :: Member Choose r => [a] -> Eff r a
@@ -45,7 +59,7 @@
 
 -- | MonadPlus-like operators are expressible via choose
 mplus' :: Member Choose r => Eff r a -> Eff r a -> Eff r a
-mplus' m1 m2 = choose [m1,m2] >>= id
+mplus' m1 m2 = join $ choose [m1,m2]
 
 #if __GLASGOW_HASKELL__ > 708
 -- | MonadPlus-like operators are expressible via choose
diff --git a/src/Control/Eff/Exception.hs b/src/Control/Eff/Exception.hs
--- a/src/Control/Eff/Exception.hs
+++ b/src/Control/Eff/Exception.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
@@ -21,16 +23,28 @@
                             , ignoreFail
                             ) where
 
-import Control.Eff
-import Control.Eff.Lift
+import Control.Eff.Internal
+import Data.OpenUnion
 
 import Control.Monad (void)
+import Control.Monad.Base
+import Control.Monad.Trans.Control
 
 -- ------------------------------------------------------------------------
 -- | Exceptions
 --
 -- exceptions of the type e; no resumption
 newtype Exc e v = Exc e
+
+instance ( MonadBase m m
+         , SetMember Lift (Lift m) r
+         , MonadBaseControl m (Eff r)
+         ) => MonadBaseControl m (Eff (Exc e ': r)) where
+    type StM (Eff (Exc e ': r)) a = StM (Eff r) (Either e a)
+    liftBaseWith f = raise $ liftBaseWith $ \runInBase ->
+                       f (runInBase . runError)
+    restoreM x = do r :: Either e a <- raise (restoreM x)
+                    liftEither r
 
 type Fail = Exc ()
 
diff --git a/src/Control/Eff/Fresh.hs b/src/Control/Eff/Fresh.hs
--- a/src/Control/Eff/Fresh.hs
+++ b/src/Control/Eff/Fresh.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -6,13 +8,18 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE Safe #-}
 -- | Create unique Enumerable values.
-module Control.Eff.Fresh( Fresh (..)
+module Control.Eff.Fresh( Fresh (Fresh)
                         , fresh
                         , runFresh'
                         ) where
 
-import Control.Eff
+import Control.Eff.Internal
+import Data.OpenUnion
 
+import Control.Monad.Base
+import Control.Monad.Trans.Control
+
+
 -- There are three possible implementations
 -- The first one uses State Fresh where
 --    newtype Fresh = Fresh Int
@@ -25,18 +32,39 @@
 -- | Create unique Enumerable values.
 data Fresh v where
   Fresh :: Fresh Int
+  Replace :: !Int -> Fresh ()
 
+instance ( MonadBase m m
+         , SetMember Lift (Lift m) r
+         , MonadBaseControl m (Eff r)
+         ) => MonadBaseControl m (Eff (Fresh ': r)) where
+    type StM (Eff (Fresh ': r)) a = StM (Eff r) (a, Int)
+    liftBaseWith f = do i <- fresh
+                        raise $ liftBaseWith $ \runInBase ->
+                          f (\k -> runInBase $ runFreshReturn k i)
+    restoreM x = do (r,i) <- raise (restoreM x)
+                    replace i
+                    return r
+
+
 -- | Produce a value that has not been previously produced.
 fresh :: Member Fresh r => Eff r Int
 fresh = send Fresh
 
+replace :: Member Fresh r => Int -> Eff r ()
+replace = send . Replace
+
 -- | Run an effect requiring unique values.
 runFresh' :: Eff (Fresh ': r) w -> Int -> Eff r w
-runFresh' m s =
-  handle_relay_s s (\_s x -> return x)
-                   (\s' Fresh k -> (k $! s' + 1) s')
-                   m
+runFresh' m s = fst `fmap` runFreshReturn m s
 
+runFreshReturn :: Eff (Fresh ': r) w -> Int -> Eff r (w,Int)
+runFreshReturn m s =
+  handle_relay_s s (\s' x -> return (x,s'))
+                   (\s' e k -> case e of
+                                 Fresh -> (k $! s' + 1) s'
+                                 Replace i -> k i ())
+                   m
 {-
 -- Finally, the worst implementation but the one that answers
 -- reviewer's question: implementing Fresh in terms of State
diff --git a/src/Control/Eff/Internal.hs b/src/Control/Eff/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Eff/Internal.hs
@@ -0,0 +1,266 @@
+{-# OPTIONS_GHC -Werror #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+{-# LANGUAGE CPP #-}
+
+-- ------------------------------------------------------------------------
+-- | A monadic library for communication between a handler and
+-- its client, the administered computation
+--
+-- Original work available at <http://okmij.org/ftp/Haskell/extensible/tutorial.html>.
+-- This module implements extensible effects as an alternative to monad transformers,
+-- as described in <http://okmij.org/ftp/Haskell/extensible/exteff.pdf> and
+-- <http://okmij.org/ftp/Haskell/extensible/more.pdf>.
+--
+-- Extensible Effects are implemented as typeclass constraints on an Eff[ect] datatype.
+-- A contrived example can be found under "Control.Eff.Example". To run the
+-- effects, consult the tests.
+module Control.Eff.Internal ( module Control.Eff.Internal
+                            ) where
+
+#if __GLASGOW_HASKELL__ < 710
+import Control.Applicative
+#endif
+import qualified Control.Arrow as A
+import qualified Control.Category as C
+import Control.Monad.Base (MonadBase(..))
+import Control.Monad.Trans.Control (MonadBaseControl(..))
+import safe Data.OpenUnion
+import safe Data.FTCQueue
+import GHC.Exts (inline)
+
+-- | Effectful arrow type: a function from a to b that also does effects
+-- denoted by r
+type Arr r a b = a -> Eff r b
+
+-- | An effectful function from 'a' to 'b' that is a composition of one or more
+-- effectful functions. The paremeter r describes the overall effect.
+--
+-- The composition members are accumulated in a type-aligned queue.
+-- Using a newtype here enables us to define `Category' and `Arrow' instances.
+newtype Arrs r a b = Arrs (FTCQueue (Eff r) a b)
+
+-- | 'Arrs' can be composed and have a natural identity.
+instance C.Category (Arrs r) where
+  id = ident
+  f . g = comp g f
+
+-- | As the name suggests, 'Arrs' also has an 'Arrow' instance.
+instance A.Arrow (Arrs r) where
+  arr = arr
+  first = singleK . first . (^$)
+
+first :: Arr r a b -> Arr r (a, c) (b, c)
+first x = \(a,c) -> (, c) `fmap` x a
+
+-- | convert single effectful arrow into composable type. i.e., convert 'Arr' to
+-- 'Arrs'
+{-# INLINE singleK #-}
+singleK :: Arr r a b -> Arrs r a b
+singleK = Arrs . tsingleton
+
+-- | Application to the `generalized effectful function' Arrs r b w, i.e.,
+-- convert 'Arrs' to 'Arr'
+{-# INLINABLE qApp #-}
+qApp :: forall r b w. Arrs r b w -> Arr r b w
+qApp (Arrs q) x = viewlMap (inline tviewl q) ($ x) cons
+  where
+    cons :: forall x. Arr r b x -> FTCQueue (Eff r) x w -> Eff r w
+    cons = \k t -> case k x of
+      Val y -> qApp (Arrs t) y
+      E u (Arrs q0) -> E u (Arrs (q0 >< t))
+{-
+-- A bit more understandable version
+qApp :: Arrs r b w -> b -> Eff r w
+qApp q x = case tviewl q of
+   TOne k  -> k x
+   k :| t -> bind' (k x) t
+ where
+   bind' :: Eff r a -> Arrs r a b -> Eff r b
+   bind' (Pure y) k     = qApp k y
+   bind' (Impure u q) k = Impure u (q >< k)
+-}
+
+-- | Syntactic sugar for 'qApp'
+{-# INLINABLE (^$) #-}
+(^$) :: forall r b w. Arrs r b w -> Arr r b w
+q ^$ x = q `qApp` x
+
+-- | Lift a function to an arrow
+arr :: (a -> b) -> Arrs r a b
+arr f = singleK (Val . f)
+
+-- | The identity arrow
+ident :: Arrs r a a
+ident = arr id
+
+-- | Arrow composition
+comp :: Arrs r a b -> Arrs r b c -> Arrs r a c
+comp (Arrs f) (Arrs g) = Arrs (f >< g)
+
+-- | Common pattern: append 'Arr' to 'Arrs'
+(^|>) :: Arrs r a b -> Arr r b c -> Arrs r a c
+(Arrs f) ^|> g = Arrs (f |> g)
+
+-- | The Eff monad (not a transformer!). It is a fairly standard coroutine monad
+-- where the type @r@ is the type of effects that can be handled, and the
+-- missing type @a@ (from the type application) is the type of value that is
+-- returned.  It is NOT a Free monad! There are no Functor constraints.
+--
+-- The two constructors denote the status of a coroutine (client): done with the
+-- value of type a, or sending a request of type Union r with the continuation
+-- Arrs r b a. Expressed another way: an `Eff` can either be a value (i.e.,
+-- 'Val' case), or an effect of type @`Union` r@ producing another `Eff` (i.e.,
+-- 'E' case). The result is that an `Eff` can produce an arbitrarily long chain
+-- of @`Union` r@ effects, terminated with a pure value.
+--
+-- Potentially, inline Union into E
+data Eff r a = Val a
+             | forall b. E  (Union r b) (Arrs r b a)
+
+-- | Compose effectful arrows (and possibly change the effect!)
+{-# INLINE qComp #-}
+qComp :: Arrs r a b -> (Eff r b -> Eff r' c) -> Arr r' a c
+-- qComp g h = (h . (g `qApp`))
+qComp g h = \a -> h $ (g ^$ a)
+
+-- | Compose effectful arrows (and possibly change the effect!)
+{-# INLINE qComps #-}
+qComps :: Arrs r a b -> (Eff r b -> Eff r' c) -> Arrs r' a c
+qComps g h = singleK $ qComp g h
+
+-- | Eff is still a monad and a functor (and Applicative)
+-- (despite the lack of the Functor constraint)
+instance Functor (Eff r) where
+  {-# INLINE fmap #-}
+  fmap f (Val x) = Val (f x)
+  fmap f (E u q) = E u (q ^|> (Val . f)) -- does no mapping yet!
+
+instance Applicative (Eff r) where
+  {-# INLINE pure #-}
+  pure = Val
+  Val f <*> e = f `fmap` e
+  E u q <*> e = E u (q ^|> (`fmap` e))
+
+instance Monad (Eff r) where
+  {-# INLINE return #-}
+  {-# INLINE [2] (>>=) #-}
+  return = pure
+  Val x >>= k = k x
+  E u q >>= k = E u (q ^|> k)          -- just accumulates continuations
+{-
+  Val _ >> m = m
+  E u q >> m = E u (q ^|> const m)
+-}
+
+instance (MonadBase b m, SetMember Lift (Lift m) r) => MonadBase b (Eff r) where
+    liftBase = lift . liftBase
+    {-# INLINE liftBase #-}
+
+instance (MonadBase m m)  => MonadBaseControl m (Eff '[Lift m]) where
+    type StM (Eff '[Lift m]) a = a
+    liftBaseWith f = lift (f runLift)
+    restoreM = return
+
+-- | Send a request and wait for a reply (resulting in an effectful
+-- computation).
+{-# INLINE [2] send #-}
+send :: Member t r => t v -> Eff r v
+send t = E (inj t) (singleK Val)
+-- This seems to be a very beneficial rule! On micro-benchmarks, cuts
+-- the needed memory in half and speeds up almost twice.
+{-# RULES
+  "send/bind" [~3] forall t k. send t >>= k = E (inj t) (singleK k)
+ #-}
+
+
+-- ------------------------------------------------------------------------
+-- | The initial case, no effects. Get the result from a pure computation.
+--
+-- The type of run ensures that all effects must be handled:
+-- only pure computations may be run.
+run :: Eff '[] w -> w
+run (Val x) = x
+-- | the other case is unreachable since Union [] a cannot be
+-- constructed.
+-- Therefore, run is a total function if its argument terminates.
+run (E _ _) = error "extensible-effects: the impossible happened!"
+
+-- | A convenient pattern: given a request (open union), either
+-- handle it or relay it.
+{-# INLINE handle_relay #-}
+handle_relay :: (a -> Eff r w) ->
+                (forall v. t v -> Arr r v w -> Eff r w) ->
+                Eff (t ': r) a -> Eff r w
+handle_relay ret h m = loop m
+ where
+  loop (Val x)  = ret x
+  loop (E u q)  = case decomp u of
+    Right x -> h x k
+    Left  u0 -> E u0 (singleK k)
+   where k = qComp q loop
+
+-- | Parameterized handle_relay
+{-# INLINE handle_relay_s #-}
+handle_relay_s :: s ->
+                (s -> a -> Eff r w) ->
+                (forall v. s -> t v -> (s -> Arr r v w) -> Eff r w) ->
+                Eff (t ': r) a -> Eff r w
+handle_relay_s s ret h m = loop s m
+  where
+    loop s0 (Val x)  = ret s0 x
+    loop s0 (E u q)  = case decomp u of
+      Right x -> h s0 x k
+      Left  u0 -> E u0 (singleK (k s0))
+     where k s1 x = loop s1 $ qApp q x
+
+-- | Add something like Control.Exception.catches? It could be useful
+-- for control with cut.
+--
+-- Intercept the request and possibly reply to it, but leave it unhandled
+-- (that's why we use the same r all throuout)
+{-# INLINE interpose #-}
+interpose :: Member t r =>
+             (a -> Eff r w) -> (forall v. t v -> Arr r v w -> Eff r w) ->
+             Eff r a -> Eff r w
+interpose ret h m = loop m
+ where
+   loop (Val x)  = ret x
+   loop (E u q)  = case prj u of
+     Just x -> h x k
+     _      -> E u (singleK k)
+    where k = qComp q loop
+
+-- | Embeds a less-constrained 'Eff' into a more-constrained one. Analogous to
+-- MTL's 'lift'.
+raise :: Eff r a -> Eff (e ': r) a
+raise = loop
+  where
+    loop (Val x) = pure x
+    loop (E u q) = E (weaken u) $ qComps q loop
+{-# INLINE raise #-}
+
+-- ------------------------------------------------------------------------
+-- | Lifting: emulating monad transformers
+newtype Lift m a = Lift (m a)
+
+-- | We make the Lift layer to be unique, using SetMember
+lift :: (SetMember Lift (Lift m) r) => m a -> Eff r a
+lift = send . Lift
+
+-- | The handler of Lift requests. It is meant to be terminal:
+-- we only allow a single Lifted Monad.
+runLift :: Monad m => Eff '[Lift m] w -> m w
+runLift (Val x) = return x
+runLift (E u q) = case prj u of
+                  Just (Lift m) -> m >>= runLift . qApp q
+                  Nothing -> error "Impossible: Nothing cannot occur"
+
diff --git a/src/Control/Eff/Lift.hs b/src/Control/Eff/Lift.hs
--- a/src/Control/Eff/Lift.hs
+++ b/src/Control/Eff/Lift.hs
@@ -1,40 +1,27 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE Safe #-}
 -- | Lifting primitive Monad types to effectful computations.
 -- We only allow a single Lifted Monad because Monads aren't commutative
 -- (e.g. Maybe (IO a) is functionally distinct from IO (Maybe a)).
 module Control.Eff.Lift ( Lift (..)
-                       , lift
-                       , runLift
-                       , catchDynE
-                       ) where
+                        , Lifted
+                        , lift
+                        , runLift
+                        , catchDynE
+                        ) where
 
-import Control.Eff
+import Control.Eff.Internal
 import qualified Control.Exception as Exc
-
--- ------------------------------------------------------------------------
--- | Lifting: emulating monad transformers
-newtype Lift m a = Lift (m a)
-
--- | We make the Lift layer to be unique, using SetMember
-lift :: (SetMember Lift (Lift m) r) => m a -> Eff r a
-lift = send . Lift
+import Data.OpenUnion
 
--- | The handler of Lift requests. It is meant to be terminal:
--- we only allow a single Lifted Monad.
-runLift :: Monad m => Eff '[Lift m] w -> m w
-runLift (Val x) = return x
-runLift (E u q) = case prj u of
-                  Just (Lift m) -> m >>= runLift . qApp q
-                  Nothing -> error "Impossible: Nothing cannot occur"
+-- |A convenient alias to 'SetMember Lift (Lift m) r'
+type Lifted m r = SetMember Lift (Lift m) r
 
 -- | Catching of dynamic exceptions
 -- See the problem in
 -- http://okmij.org/ftp/Haskell/misc.html#catch-MonadIO
 catchDynE :: forall e a r.
-             (SetMember Lift (Lift IO) r, Exc.Exception e) =>
+             (Lifted IO r, Exc.Exception e) =>
              Eff r a -> (e -> Eff r a) -> Eff r a
 catchDynE m eh = interpose return h m
  where
diff --git a/src/Control/Eff/NdetEff.hs b/src/Control/Eff/NdetEff.hs
--- a/src/Control/Eff/NdetEff.hs
+++ b/src/Control/Eff/NdetEff.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeFamilies #-}
 {-# OPTIONS_GHC -Werror -fno-warn-orphans #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -13,10 +14,14 @@
 -- | Another implementation of nondeterministic choice effect
 module Control.Eff.NdetEff where
 
-import Control.Eff
+import Control.Eff.Internal
+import Data.OpenUnion
 
-import Control.Monad
 import Control.Applicative
+import Control.Monad
+import Control.Monad.Base
+import Control.Monad.Trans.Control
+import Data.Foldable (foldl')
 
 -- | A different implementation, more directly mapping to MonadPlus
 -- interface
@@ -32,6 +37,16 @@
   mzero = send MZero
   mplus m1 m2 = send MPlus >>= \x -> if x then m1 else m2
 
+instance ( MonadBase m m
+         , SetMember Lift (Lift m) r
+         , MonadBaseControl m (Eff r)
+         ) => MonadBaseControl m (Eff (NdetEff ': r)) where
+    type StM (Eff (NdetEff ': r)) a = StM (Eff r) [a]
+    liftBaseWith f = raise $ liftBaseWith $ \runInBase ->
+                       f (runInBase . makeChoiceLst)
+    restoreM x = do lst :: [a] <- raise (restoreM x)
+                    foldl' (\r a -> r <|> pure a) mzero lst
+
 -- | An interpreter
 -- The following is very simple, but leaks a lot of memory
 -- The cause probably is mapping every failure to empty
@@ -57,6 +72,10 @@
      Right MPlus -> loop (q ^$ False : jq) (q ^$ True)
      Left  u0 -> E u0 (singleK (\x -> loop jq (q ^$ x)))
 
+-- | Same as makeChoiceA, except it has the type hardcoded.
+-- Required for MonadBaseControl instance.
+makeChoiceLst :: Eff (NdetEff ': r) a -> Eff r [a]
+makeChoiceLst = makeChoiceA
 -- ------------------------------------------------------------------------
 -- Soft-cut: non-deterministic if-then-else, aka Prolog's *->
 -- Declaratively,
diff --git a/src/Control/Eff/Reader/Lazy.hs b/src/Control/Eff/Reader/Lazy.hs
--- a/src/Control/Eff/Reader/Lazy.hs
+++ b/src/Control/Eff/Reader/Lazy.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
@@ -13,8 +15,12 @@
                               , runReader
                               ) where
 
-import Control.Eff
+import Control.Eff.Internal
+import Data.OpenUnion
 
+import Control.Monad.Base
+import Control.Monad.Trans.Control
+
 -- ------------------------------------------------------------------------
 -- | The Reader monad
 --
@@ -67,3 +73,13 @@
 -- | Request the environment value using a transformation function.
 reader :: (Member (Reader e) r) => (e -> a) -> Eff r a
 reader f = f `fmap` ask
+
+instance ( MonadBase m m
+         , SetMember Lift (Lift m) s
+         , MonadBaseControl m (Eff s)
+         ) => MonadBaseControl m (Eff (Reader e ': s)) where
+    type StM (Eff (Reader e ': s)) a = StM (Eff s) a
+    liftBaseWith f = do e <- ask
+                        raise $ liftBaseWith $ \runInBase ->
+                          f (\k -> runInBase $ runReader k e)
+    restoreM = raise . restoreM
diff --git a/src/Control/Eff/Reader/Strict.hs b/src/Control/Eff/Reader/Strict.hs
--- a/src/Control/Eff/Reader/Strict.hs
+++ b/src/Control/Eff/Reader/Strict.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -14,8 +16,12 @@
                               , runReader
                               ) where
 
-import Control.Eff
+import Control.Eff.Internal
+import Data.OpenUnion
 
+import Control.Monad.Base
+import Control.Monad.Trans.Control
+
 -- ------------------------------------------------------------------------
 -- | The Reader monad
 --
@@ -68,3 +74,13 @@
 -- | Request the environment value using a transformation function.
 reader :: (Member (Reader e) r) => (e -> a) -> Eff r a
 reader f = f `fmap` ask
+
+instance ( MonadBase m m
+         , SetMember Lift (Lift m) s
+         , MonadBaseControl m (Eff s)
+         ) => MonadBaseControl m (Eff (Reader e ': s)) where
+    type StM (Eff (Reader e ': s)) a = StM (Eff s) a
+    liftBaseWith f = do !e <- ask
+                        raise $ liftBaseWith $ \runInBase ->
+                          f (\k -> runInBase $ runReader k e)
+    restoreM = raise . restoreM
diff --git a/src/Control/Eff/State/Lazy.hs b/src/Control/Eff/State/Lazy.hs
--- a/src/Control/Eff/State/Lazy.hs
+++ b/src/Control/Eff/State/Lazy.hs
@@ -1,4 +1,6 @@
 {-# OPTIONS_GHC -Werror #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
@@ -10,10 +12,14 @@
 -- | Lazy state effect
 module Control.Eff.State.Lazy where
 
-import Control.Eff
+import Control.Eff.Internal
 import Control.Eff.Writer.Lazy
 import Control.Eff.Reader.Lazy
+import Data.OpenUnion
 
+import Control.Monad.Base
+import Control.Monad.Trans.Control
+
 -- ------------------------------------------------------------------------
 -- | State, lazy
 --
@@ -34,6 +40,18 @@
 data State s v where
   Get :: State s s
   Put :: s -> State s ()
+
+instance ( MonadBase m m
+         , SetMember Lift (Lift m) r
+         , MonadBaseControl m (Eff r)
+         ) => MonadBaseControl m (Eff (State s ': r)) where
+    type StM (Eff (State s ': r)) a = StM (Eff r) (a,s)
+    liftBaseWith f = do s <- get
+                        raise $ liftBaseWith $ \runInBase ->
+                          f (\k -> runInBase $ runState k s)
+    restoreM x = do (a, s :: s) <- raise (restoreM x)
+                    put s
+                    return a
 
 -- | Return the current value of the state. The signatures are inferred
 {-# NOINLINE get #-}
diff --git a/src/Control/Eff/State/OnDemand.hs b/src/Control/Eff/State/OnDemand.hs
--- a/src/Control/Eff/State/OnDemand.hs
+++ b/src/Control/Eff/State/OnDemand.hs
@@ -1,4 +1,6 @@
 {-# OPTIONS_GHC -Werror #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
@@ -10,10 +12,14 @@
 -- | Lazy state effect
 module Control.Eff.State.OnDemand where
 
-import Control.Eff
+import Control.Eff.Internal
 import Control.Eff.Writer.Lazy
 import Control.Eff.Reader.Lazy
+import Data.OpenUnion
 
+import Control.Monad.Base
+import Control.Monad.Trans.Control
+
 -- ------------------------------------------------------------------------
 -- | State, lazy (i.e., on-demand)
 --
@@ -25,6 +31,19 @@
   Get  :: OnDemandState s s
   Put  :: s -> OnDemandState s ()
   Delay :: Eff '[OnDemandState s] a  -> OnDemandState s a --  Eff as a transformer
+
+instance ( MonadBase m m
+         , SetMember Lift (Lift m) r
+         , MonadBaseControl m (Eff r)
+         ) => MonadBaseControl m (Eff (OnDemandState s ': r)) where
+    type StM (Eff (OnDemandState s ': r)) a = StM (Eff r) (a,s)
+    liftBaseWith f = do s <- get
+                        raise $ liftBaseWith $ \runInBase ->
+                          f (\k -> runInBase $ runState k s)
+    restoreM x = do (a, s :: s) <- raise (restoreM x)
+                    put s
+                    return a
+
 
 -- | Return the current value of the state. The signatures are inferred
 {-# NOINLINE get #-}
diff --git a/src/Control/Eff/State/Strict.hs b/src/Control/Eff/State/Strict.hs
--- a/src/Control/Eff/State/Strict.hs
+++ b/src/Control/Eff/State/Strict.hs
@@ -1,4 +1,6 @@
 {-# OPTIONS_GHC -Werror #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -11,10 +13,14 @@
 -- | Strict state effect
 module Control.Eff.State.Strict where
 
-import Control.Eff
+import Control.Eff.Internal
 import Control.Eff.Writer.Strict
 import Control.Eff.Reader.Strict
+import Data.OpenUnion
 
+import Control.Monad.Base
+import Control.Monad.Trans.Control
+
 -- ------------------------------------------------------------------------
 -- | State, strict
 --
@@ -35,6 +41,19 @@
 data State s v where
   Get :: State s s
   Put :: !s -> State s ()
+
+instance ( MonadBase m m
+         , SetMember Lift (Lift m) r
+         , MonadBaseControl m (Eff r)
+         ) => MonadBaseControl m (Eff (State s ': r)) where
+    type StM (Eff (State s ': r)) a = StM (Eff r) (a,s)
+    liftBaseWith f = do s <- get
+                        raise $ liftBaseWith $ \runInBase ->
+                          f (\k -> runInBase $ runState k s)
+    restoreM x = do !(a, s :: s) <- raise (restoreM x)
+                    put s
+                    return a
+
 
 -- | Return the current value of the state. The signatures are inferred
 {-# NOINLINE get #-}
diff --git a/src/Control/Eff/Writer/Lazy.hs b/src/Control/Eff/Writer/Lazy.hs
--- a/src/Control/Eff/Writer/Lazy.hs
+++ b/src/Control/Eff/Writer/Lazy.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
@@ -16,11 +18,15 @@
                                , runMonoidWriter
                                ) where
 
-import Control.Eff
+import Control.Eff.Internal
+import Data.OpenUnion
 
-import Data.Monoid
 import Control.Applicative ((<|>))
 
+import Control.Monad.Base
+import Control.Monad.Trans.Control
+import Data.Monoid
+
 -- ------------------------------------------------------------------------
 -- | The Writer monad
 --
@@ -30,6 +36,17 @@
 -- the |Monoid w| constraint then
 data Writer w v where
   Tell :: w -> Writer w ()
+
+instance ( MonadBase m m
+         , SetMember Lift (Lift m) r
+         , MonadBaseControl m (Eff r)
+         ) => MonadBaseControl m (Eff (Writer w ': r)) where
+    type StM (Eff (Writer w ': r)) a = StM (Eff r) (a, [w])
+    liftBaseWith f = raise $ liftBaseWith $ \runInBase ->
+                       f (runInBase . runListWriter)
+    restoreM x = do (a, ws :: [w]) <- raise (restoreM x)
+                    mapM_ tell ws
+                    return a
 
 -- | Write a new value.
 tell :: Member (Writer w) r => w -> Eff r ()
diff --git a/src/Control/Eff/Writer/Strict.hs b/src/Control/Eff/Writer/Strict.hs
--- a/src/Control/Eff/Writer/Strict.hs
+++ b/src/Control/Eff/Writer/Strict.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -17,11 +19,15 @@
                                , runMonoidWriter
                                ) where
 
-import Control.Eff
+import Control.Eff.Internal
+import Data.OpenUnion
 
-import Data.Monoid
 import Control.Applicative ((<|>))
 
+import Control.Monad.Base
+import Control.Monad.Trans.Control
+import Data.Monoid
+
 -- ------------------------------------------------------------------------
 -- | The Writer monad
 --
@@ -31,6 +37,17 @@
 -- the |Monoid w| constraint then
 data Writer w v where
   Tell :: !w -> Writer w ()
+
+instance ( MonadBase m m
+         , SetMember Lift (Lift m) r
+         , MonadBaseControl m (Eff r)
+         ) => MonadBaseControl m (Eff (Writer w ': r)) where
+    type StM (Eff (Writer w ': r)) a = StM (Eff r) (a, [w])
+    liftBaseWith f = raise $ liftBaseWith $ \runInBase ->
+                       f (runInBase . runListWriter)
+    restoreM x = do !(a, ws :: [w]) <- raise (restoreM x)
+                    mapM_ tell ws
+                    return a
 
 -- | Write a new value.
 tell :: Member (Writer w) r => w -> Eff r ()
diff --git a/test/Control/Eff/Choose/Test.hs b/test/Control/Eff/Choose/Test.hs
--- a/test/Control/Eff/Choose/Test.hs
+++ b/test/Control/Eff/Choose/Test.hs
@@ -8,6 +8,7 @@
 import Control.Eff.Example
 import Control.Eff.Example.Test (ex2)
 import Control.Eff.Exception
+import Control.Eff.Lift
 import Control.Eff.Choose
 import Utils
 
@@ -55,3 +56,6 @@
     exRec m = catchError m handler
       where handler (TooBig n) | n <= 7 = return n
             handler e = throwError e
+
+case_Choose_monadBaseControl :: Assertion
+case_Choose_monadBaseControl = runLift (makeChoice $ doThing $ choose [1,2,3]) @=? Just [1,2,3]
diff --git a/test/Control/Eff/Exception/Test.hs b/test/Control/Eff/Exception/Test.hs
--- a/test/Control/Eff/Exception/Test.hs
+++ b/test/Control/Eff/Exception/Test.hs
@@ -9,6 +9,7 @@
 import Test.HUnit hiding (State)
 import Control.Eff
 import Control.Eff.Exception
+import Control.Eff.Lift
 import Control.Eff.Writer.Strict
 #if __GLASGOW_HASKELL__ < 710
 import Data.Monoid
@@ -92,3 +93,10 @@
         tell (4 :: Int)
         return 5
    in assertEqual "Fail should stop writing" 6 ret
+
+case_Exception1_monadBaseControl :: Assertion
+case_Exception1_monadBaseControl =
+    runLift (runError act) @=? Just (Left "Fail")
+  where
+    act = doThing $ do _ <- throwError "Fail"
+                       return "Success"
diff --git a/test/Control/Eff/Fresh/Test.hs b/test/Control/Eff/Fresh/Test.hs
--- a/test/Control/Eff/Fresh/Test.hs
+++ b/test/Control/Eff/Fresh/Test.hs
@@ -7,6 +7,7 @@
 
 import Test.HUnit hiding (State)
 import Control.Eff.Fresh
+import Control.Eff.Lift
 import Control.Eff.Trace
 import Utils
 
@@ -26,3 +27,8 @@
       trace $ "Fresh " ++ show n
       n <- fresh
       trace $ "Fresh " ++ show n
+
+case_Fresh_monadBaseControl :: Assertion
+case_Fresh_monadBaseControl = runLift (runFresh' (doThing $ fresh >> fresh) i) @=? Just (i + 1)
+  where
+    i = 0
diff --git a/test/Control/Eff/NdetEff/Test.hs b/test/Control/Eff/NdetEff/Test.hs
--- a/test/Control/Eff/NdetEff/Test.hs
+++ b/test/Control/Eff/NdetEff/Test.hs
@@ -5,10 +5,13 @@
 module Control.Eff.NdetEff.Test (testGroups) where
 
 import Test.HUnit hiding (State)
+import Control.Applicative
 import Control.Eff
+import Control.Eff.Lift
 import Control.Eff.NdetEff
 import Control.Eff.Writer.Strict
 import Control.Monad (msum, guard, mzero, mplus)
+import Utils
 
 import Test.Framework.TH
 import Test.Framework.Providers.HUnit
@@ -70,3 +73,6 @@
     tsplit =
       (tell "begin" >> return 1) `mplus`
       (tell "end"   >> return 2)
+
+case_NdetEff_monadBaseControl :: Assertion
+case_NdetEff_monadBaseControl = runLift (makeChoiceA $ doThing (return 1 <|> return 2)) @=? Just [1,2]
diff --git a/test/Control/Eff/Reader/Lazy/Test.hs b/test/Control/Eff/Reader/Lazy/Test.hs
--- a/test/Control/Eff/Reader/Lazy/Test.hs
+++ b/test/Control/Eff/Reader/Lazy/Test.hs
@@ -8,6 +8,7 @@
 
 import Test.HUnit hiding (State)
 import Control.Eff
+import Control.Eff.Lift
 import Control.Eff.Reader.Lazy
 import Control.Monad
 import Utils
@@ -95,3 +96,10 @@
     voidReader = do
         _ <- (ask :: Eff '[Reader ()] ())
         return ()
+
+case_Lazy1_Reader_monadBaseControl :: Assertion
+case_Lazy1_Reader_monadBaseControl =
+      runLift (runReader act i) @=? (Just i)
+    where
+        act = doThing ask
+        i = 10 :: Int
diff --git a/test/Control/Eff/Reader/Strict/Test.hs b/test/Control/Eff/Reader/Strict/Test.hs
--- a/test/Control/Eff/Reader/Strict/Test.hs
+++ b/test/Control/Eff/Reader/Strict/Test.hs
@@ -7,6 +7,7 @@
 
 import Test.HUnit hiding (State)
 import Control.Eff
+import Control.Eff.Lift
 import Control.Eff.Reader.Strict
 import Utils
 
@@ -24,3 +25,10 @@
     voidReader = do
         _ <- (ask :: Eff '[Reader ()] ())
         return ()
+
+case_Strict1_Reader_monadBaseControl :: Assertion
+case_Strict1_Reader_monadBaseControl =
+      runLift (runReader act i) @=? (Just i)
+    where
+        act = doThing ask
+        i = 10 :: Int
diff --git a/test/Control/Eff/State/Lazy/Test.hs b/test/Control/Eff/State/Lazy/Test.hs
--- a/test/Control/Eff/State/Lazy/Test.hs
+++ b/test/Control/Eff/State/Lazy/Test.hs
@@ -7,6 +7,7 @@
 
 import Test.HUnit hiding (State)
 import Control.Eff
+import Control.Eff.Lift
 import Control.Eff.State.Lazy
 import Utils
 
@@ -30,3 +31,9 @@
 
     putVoid :: () -> Eff '[State ()] ()
     putVoid = put
+
+case_Lazy1_State_monadBaseControl :: Assertion
+case_Lazy1_State_monadBaseControl = runLift (runState (doThing $ modify f) i) @=? Just ((), i + 1)
+  where
+    i = 0 :: Int
+    f = succ :: Int -> Int
diff --git a/test/Control/Eff/State/OnDemand/Test.hs b/test/Control/Eff/State/OnDemand/Test.hs
--- a/test/Control/Eff/State/OnDemand/Test.hs
+++ b/test/Control/Eff/State/OnDemand/Test.hs
@@ -9,7 +9,9 @@
 import Test.HUnit hiding (State)
 import Control.Eff
 import Control.Eff.Exception
+import Control.Eff.Lift
 import Control.Eff.State.OnDemand
+import Utils
 
 import Test.Framework.TH
 import Test.Framework.Providers.HUnit
@@ -106,3 +108,9 @@
         put ((1::Int):s)
   in
     assertEqual "OnDemandState ones" [1,1,1,1,1] (take 5 ones)
+
+case_LazierState_monadBaseControl :: Assertion
+case_LazierState_monadBaseControl = runLift (runState (doThing $ modify f) i) @=? Just ((), i + 1)
+  where
+    i = 0 :: Int
+    f = succ :: Int -> Int
diff --git a/test/Control/Eff/State/Strict/Test.hs b/test/Control/Eff/State/Strict/Test.hs
--- a/test/Control/Eff/State/Strict/Test.hs
+++ b/test/Control/Eff/State/Strict/Test.hs
@@ -8,6 +8,7 @@
 import Test.HUnit hiding (State)
 import Control.Eff
 import Control.Eff.Exception
+import Control.Eff.Lift
 import Control.Eff.State.Strict
 import Control.Eff.Reader.Strict
 import Control.Eff.Writer.Strict
@@ -99,3 +100,9 @@
 case_Strict1_State_ter4 :: Assertion
 case_Strict1_State_ter4 = (Right ("exc",2) :: Either String (String,Int)) @=?
   (run $ runError (runState (teCatch tes1) (1::Int)))
+
+case_Strict1_State_monadBaseControl :: Assertion
+case_Strict1_State_monadBaseControl = runLift (runState (doThing $ modify f) i) @=? Just ((), i + 1)
+  where
+    i = 0 :: Int
+    f = succ :: Int -> Int
diff --git a/test/Control/Eff/Writer/Lazy/Test.hs b/test/Control/Eff/Writer/Lazy/Test.hs
--- a/test/Control/Eff/Writer/Lazy/Test.hs
+++ b/test/Control/Eff/Writer/Lazy/Test.hs
@@ -9,6 +9,7 @@
 import Test.QuickCheck
 
 import Control.Eff
+import Control.Eff.Lift
 import Control.Eff.Reader.Lazy
 import Control.Eff.Writer.Lazy
 import Utils
@@ -57,3 +58,9 @@
   ((), Just m) = run $ runLastWriter $ mapM_ tell [undefined, ()]
   in
    assertNoUndefined (m :: ())
+
+case_Lazy1_Writer_monadBaseControl :: Assertion
+case_Lazy1_Writer_monadBaseControl = runLift (runListWriter act) @=? Just ((), [i])
+  where
+    i = 10 :: Int
+    act = doThing (tell i)
diff --git a/test/Control/Eff/Writer/Strict/Test.hs b/test/Control/Eff/Writer/Strict/Test.hs
--- a/test/Control/Eff/Writer/Strict/Test.hs
+++ b/test/Control/Eff/Writer/Strict/Test.hs
@@ -7,6 +7,7 @@
 
 import Test.HUnit hiding (State)
 import Control.Eff
+import Control.Eff.Lift
 import Control.Eff.Writer.Strict
 import Utils
 
@@ -20,3 +21,9 @@
   ((), Just m) = run $ runLastWriter $ mapM_ tell [undefined, ()]
   in
    assertUndefined (m :: ())
+
+case_Strict1_Writer_monadBaseControl :: Assertion
+case_Strict1_Writer_monadBaseControl = runLift (runListWriter act) @=? Just ((), [i])
+  where
+    i = 10 :: Int
+    act = doThing (tell i)
diff --git a/test/Utils.hs b/test/Utils.hs
--- a/test/Utils.hs
+++ b/test/Utils.hs
@@ -4,6 +4,7 @@
 
 import Control.Exception (ErrorCall, catch)
 import Control.Monad
+import Control.Monad.Trans.Control
 
 import System.IO.Silently
 import Data.Tuple (swap)
@@ -41,3 +42,9 @@
 
 add :: Monad m => m Int -> m Int -> m Int
 add = liftM2 (+)
+
+doThing :: MonadBaseControl b m => m a -> m a
+doThing = liftBaseOp_ go
+  where
+    go :: Monad m => m a -> m a
+    go a = return () >> a