diff --git a/Control/Monad/Sharing.hs b/Control/Monad/Sharing.hs
--- a/Control/Monad/Sharing.hs
+++ b/Control/Monad/Sharing.hs
@@ -3,7 +3,12 @@
      Rank2Types
   #-}
 
-module Control.Monad.Sharing where
+module Control.Monad.Sharing (
+
+  module Control.Monad, 
+  module Control.Monad.Sharing
+
+ ) where
 
 import Control.Monad
 
diff --git a/Control/Monad/Sharing/Lazy.hs b/Control/Monad/Sharing/Lazy.hs
--- a/Control/Monad/Sharing/Lazy.hs
+++ b/Control/Monad/Sharing/Lazy.hs
@@ -4,12 +4,10 @@
 
   Lazy, runLazy, evalLazy,
 
-  module Control.Monad,
   module Control.Monad.Sharing
 
  ) where
 
-import Control.Monad
 import Control.Monad.Sharing
 import Control.Monad.Sharing.Lazy.ContReaderNoThunksInlined
 
diff --git a/Control/Monad/Sharing/Lazy/ContReader.hs b/Control/Monad/Sharing/Lazy/ContReader.hs
--- a/Control/Monad/Sharing/Lazy/ContReader.hs
+++ b/Control/Monad/Sharing/Lazy/ContReader.hs
@@ -1,18 +1,47 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}
+
 module Control.Monad.Sharing.Lazy.ContReader where
 
 import Control.Monad.Trans.ContT
 import Control.Monad.State
 import Control.Monad.Reader
+import Control.Monad.Writer
 import Control.Monad.Sharing
 import Control.Monad.Sharing.Memoization
 
-newtype Lazy m a = Lazy { fromLazy :: ContT (ReaderT ThunkStore m) a }
- deriving (Monad, MonadPlus, MonadState ThunkStore)
+type Env = (ThunkStore, Shared)
 
+newtype Lazy m a = Lazy { fromLazy :: ContT (ReaderT Env m) a }
+ deriving MonadPlus
+
+instance Monad m => Monad (Lazy m)
+ where
+  return x = Lazy (return x)
+  m >>= k  = Lazy (do x <- fromLazy m
+                      modify (\ (ts,_) -> (ts,Shared False))
+                      fromLazy (k x))
+
+instance Monad m => MonadState ThunkStore (Lazy m)
+ where
+  get    = Lazy (liftM fst get)
+  put ts = Lazy (modify (\ (_,s) -> (ts,s)))
+
+instance Monad m => MonadWriter Shared (Lazy m)
+ where
+  tell s   = Lazy (modify (\ (ts,_) -> (ts,s)))
+  listen m = Lazy (do x <- fromLazy m
+                      s <- gets snd
+                      return (x,s))
+  pass m   = Lazy (do (x,f) <- fromLazy m
+                      (ts,s) <- get
+                      put (ts,f s)
+                      return x)
+
 runLazy :: Monad m => Lazy m a -> m a
-runLazy m = runReaderT (runContT (fromLazy m)) emptyThunkStore
+runLazy m = runReaderT (runContT (fromLazy m)) (emptyThunkStore, Shared False)
 
 instance MonadPlus m => Sharing (Lazy m)
  where
-  share a = memo (a >>= mapNondet share)
-
+  share a = memo $ do (x,s) <- listen a
+                      if isShared s then shared (return x)
+                       else mapNondet share x
diff --git a/Control/Monad/Sharing/Lazy/ContReaderNoThunks.hs b/Control/Monad/Sharing/Lazy/ContReaderNoThunks.hs
--- a/Control/Monad/Sharing/Lazy/ContReaderNoThunks.hs
+++ b/Control/Monad/Sharing/Lazy/ContReaderNoThunks.hs
@@ -1,17 +1,22 @@
+{-# LANGUAGE
+     GeneralizedNewtypeDeriving, 
+     MultiParamTypeClasses, 
+     FlexibleContexts
+  #-}
+
 module Control.Monad.Sharing.Lazy.ContReaderNoThunks where
 
 import Control.Monad.Trans.ContT
 import Control.Monad.State
 import Control.Monad.Reader
+import Control.Monad.Writer
 import Control.Monad.Sharing
-import Control.Monad.Sharing.Memoization ( Untyped(..), typed )
+import Control.Monad.Sharing.Memoization
+ ( Untyped(..), typed, Shared(..), shared )
 
 import qualified Data.IntMap as M
 
-newtype Lazy m a = Lazy { fromLazy :: ContT (ReaderT Store m) a }
- deriving (Monad, MonadPlus, MonadState Store)
 
-
 data Store = Store Int (M.IntMap Untyped)
 
 getFreshKey :: MonadState Store m => m Int
@@ -30,17 +35,49 @@
   Store next heap <- get
   put (Store next (M.insert key (Untyped val) heap))
 
+
+type Env = (Store, Shared)
+
+newtype Lazy m a = Lazy { fromLazy :: ContT (ReaderT Env m) a }
+ deriving MonadPlus
+
 runLazy :: Monad m => Lazy m a -> m a
-runLazy m = runReaderT (runContT (fromLazy m)) (Store 1 M.empty)
+runLazy m = runReaderT (runContT (fromLazy m)) (Store 1 M.empty, Shared False)
 
+
+instance Monad m => Monad (Lazy m)
+ where
+  return x = Lazy (return x)
+  m >>= k  = Lazy (do x <- fromLazy m
+                      modify (\ (ts,_) -> (ts, Shared False))
+                      fromLazy (k x))
+
+instance Monad m => MonadState Store (Lazy m)
+ where
+  get    = Lazy (liftM fst get)
+  put ts = Lazy (modify (\ (_,s) -> (ts,s)))
+
+instance Monad m => MonadWriter Shared (Lazy m)
+ where
+  tell s   = Lazy (modify (\ (ts,_) -> (ts,s)))
+  listen m = Lazy (do x <- fromLazy m
+                      s <- gets snd
+                      return (x,s))
+  pass m   = Lazy (do (x,f) <- fromLazy m
+                      (ts,s) <- get
+                      put (ts,f s)
+                      return x)
+
 instance MonadPlus m => Sharing (Lazy m)
  where
-  share a = memo (a >>= mapNondet share)
+  share a = memo $ do (x,s) <- listen a
+                      if isShared s then shared (return x)
+                       else mapNondet share x
 
-memo :: MonadState Store m => m a -> m (m a)
+memo :: (MonadState Store m, MonadWriter Shared m) => m a -> m (m a)
 memo a = do
   key <- getFreshKey
-  return $ do
+  return . shared $ do
     thunk <- lookupHNF key
     case thunk of
       Just x  -> return x
diff --git a/Control/Monad/Sharing/Lazy/ContReaderNoThunksInlined.hs b/Control/Monad/Sharing/Lazy/ContReaderNoThunksInlined.hs
--- a/Control/Monad/Sharing/Lazy/ContReaderNoThunksInlined.hs
+++ b/Control/Monad/Sharing/Lazy/ContReaderNoThunksInlined.hs
@@ -6,49 +6,46 @@
 
 module Control.Monad.Sharing.Lazy.ContReaderNoThunksInlined where
 
-import Control.Monad.State
 import Control.Monad.Sharing
 import Control.Monad.Sharing.Memoization ( Untyped(..), typed )
 
 import qualified Data.IntMap as M
 
 newtype Lazy m a = Lazy {
-  fromLazy :: forall w . (a -> Store -> m w) -> Store -> m w
+  fromLazy :: forall w . (a -> Bool -> Store -> m w) -> Bool -> Store -> m w
  }
 
 data Store = Store Int (M.IntMap Untyped)
 
 runLazy :: Monad m => Lazy m a -> m a
-runLazy m = fromLazy m (\a _ -> return a) (Store 1 M.empty)
+runLazy m = fromLazy m (\x _ _ -> return x) False (Store 1 M.empty)
 
 instance Monad m => Monad (Lazy m)
  where
   return x = Lazy (\c -> c x)
-  a >>=  k = Lazy (\c s -> fromLazy a (\x -> fromLazy (k x) c) s)
-  fail str = Lazy (\_ _ -> fail str)
+  a >>=  k = Lazy (\c -> fromLazy a (\x _ -> fromLazy (k x) c False))
+  fail str = Lazy (\_ _ _ -> fail str)
 
 instance MonadPlus m => MonadPlus (Lazy m)
  where
-  mzero = Lazy (\_ _ -> mzero)
-
-  a `mplus` b = Lazy (\c s -> fromLazy a c s `mplus` fromLazy b c s)
+  mzero = Lazy (\_ _ _ -> mzero)
 
-instance Monad m => MonadState Store (Lazy m)
- where
-  get   = Lazy (\c s -> c s s)
-  put s = Lazy (\c _ -> c () s)
+  x `mplus` y = Lazy (\c b s -> fromLazy x c b s `mplus` fromLazy y c b s)
 
 instance MonadPlus m => Sharing (Lazy m)
  where
-  share a = memo (a >>= mapNondet share)
+  share a = memo (Lazy (\c -> 
+            fromLazy a (\x b -> 
+            if b then c x True
+                 else fromLazy (mapNondet share x) c False)))
 
 memo :: Lazy m a -> Lazy m (Lazy m a)
-memo a = Lazy (\c (Store key heap) ->
-      c (Lazy (\c s@(Store _ heap) -> 
+memo a = Lazy (\c b (Store key heap) ->
+      c (Lazy (\c b s@(Store _ heap) -> 
          case M.lookup key heap of
-          Just x  -> c (typed x) s
+          Just x  -> c (typed x) True s
           Nothing -> fromLazy a
-           (\x (Store other heap) -> 
-              c x (Store other (M.insert key (Untyped x) heap))) s))
-        (Store (succ key) heap))
+           (\x _ (Store other heap) -> 
+              c x True (Store other (M.insert key (Untyped x) heap))) b s))
+        b (Store (succ key) heap))
 
diff --git a/Control/Monad/Sharing/Lazy/Simple.hs b/Control/Monad/Sharing/Lazy/Simple.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monad/Sharing/Lazy/Simple.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}
+
+module Control.Monad.Sharing.Lazy.Simple where
+
+import Control.Monad.State
+import Control.Monad.Writer
+import Control.Monad.Sharing
+import Control.Monad.Sharing.Memoization
+
+newtype Lazy m a = Lazy {
+  fromLazy :: WriterT Shared (StateT ThunkStore m) a
+ } deriving (Monad, MonadPlus, MonadState ThunkStore, MonadWriter Shared)
+
+runLazy :: Monad m => Lazy m a -> m a
+runLazy m = do ((x,_),_) <- runStateT (runWriterT (fromLazy m)) emptyThunkStore
+               return x
+
+instance MonadPlus m => Sharing (Lazy m)
+ where
+  share a = memo $ do (x,s) <- listen a
+                      if isShared s then shared (return x)
+                       else mapNondet share x
+
diff --git a/Control/Monad/Sharing/Lazy/State.hs b/Control/Monad/Sharing/Lazy/State.hs
deleted file mode 100644
--- a/Control/Monad/Sharing/Lazy/State.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module Control.Monad.Sharing.Lazy.State where
-
-import Control.Monad.State
-import Control.Monad.Sharing
-import Control.Monad.Sharing.Memoization
-
-newtype Lazy m a = Lazy { fromLazy :: StateT ThunkStore m a }
- deriving (Monad, MonadPlus, MonadState ThunkStore)
-
-runLazy :: Monad m => Lazy m a -> m a
-runLazy m = evalStateT (fromLazy m) emptyThunkStore
-
-instance MonadPlus m => Sharing (Lazy m)
- where
-  share a = memo (a >>= mapNondet share)
-
diff --git a/Control/Monad/Sharing/Memoization.hs b/Control/Monad/Sharing/Memoization.hs
--- a/Control/Monad/Sharing/Memoization.hs
+++ b/Control/Monad/Sharing/Memoization.hs
@@ -7,14 +7,18 @@
 
   Untyped(..), typed,
 
-  ThunkStore, emptyThunkStore, memo
+  ThunkStore(..), emptyThunkStore, Shared(..), shared, memo
 
  ) where
 
 import qualified Data.IntMap as M
+
+import Data.Monoid ()
+
 import Control.Monad.State
-import Unsafe.Coerce
+import Control.Monad.Writer
 
+import Unsafe.Coerce
 
 data Untyped = forall a . Untyped a
 
@@ -26,7 +30,6 @@
 
 data Thunk m a = Uneval (m a) | Eval !a
 
-
 emptyThunkStore :: ThunkStore
 emptyThunkStore = ThunkStore { freshKey = 1, thunks = M.empty }
 
@@ -44,11 +47,21 @@
 lookupThunk key = liftM (typed . M.findWithDefault err key) (gets thunks)
  where err = error $ "lookupThunk: unbound key " ++ show key
 
-memo :: MonadState ThunkStore m => m a -> m (m a)
+
+newtype Shared = Shared { isShared :: Bool }
+
+instance Monoid Shared
+ where mempty  = Shared False
+       mappend = flip const
+
+shared :: MonadWriter Shared m => m a -> m a
+shared = censor (const (Shared True))
+
+memo :: (MonadState ThunkStore m, MonadWriter Shared m) => m a -> m (m a)
 memo a = do
   key <- getFreshKey
   insertThunk key (Uneval a)
-  return $ do
+  return . shared $ do
     thunk <- lookupThunk key
     case thunk of
       Eval x   -> return x
diff --git a/Control/Monad/Trans/ContT.hs b/Control/Monad/Trans/ContT.hs
--- a/Control/Monad/Trans/ContT.hs
+++ b/Control/Monad/Trans/ContT.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, Rank2Types #-}
+
 module Control.Monad.Trans.ContT where
 
 import Control.Monad.State
diff --git a/explicit-sharing.cabal b/explicit-sharing.cabal
--- a/explicit-sharing.cabal
+++ b/explicit-sharing.cabal
@@ -1,5 +1,5 @@
 Name:          explicit-sharing
-Version:       0.1
+Version:       0.2
 Cabal-Version: >= 1.6
 Synopsis:      Explicit Sharing of Monadic Effects
 Description:   
@@ -23,7 +23,7 @@
   Exposed-Modules:  Control.Monad.Trans.ContT,
                     Control.Monad.Sharing,
                     Control.Monad.Sharing.Lazy
-                    Control.Monad.Sharing.Lazy.State,
+                    Control.Monad.Sharing.Lazy.Simple,
                     Control.Monad.Sharing.Lazy.ContReader,
                     Control.Monad.Sharing.Lazy.ContReaderNoThunks,
                     Control.Monad.Sharing.Lazy.ContReaderNoThunksInlined