explicit-sharing 0.2 → 0.3.1

raw patch · 12 files changed

+287/−444 lines, 12 filessetup-changedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Control/Monad/Sharing.hs +122/−14
• Control/Monad/Sharing/Lazy.hs +100/−5
• Control/Monad/Sharing/Lazy/ContReader.hs +0/−47
• Control/Monad/Sharing/Lazy/ContReaderNoThunks.hs +0/−87
• Control/Monad/Sharing/Lazy/ContReaderNoThunksInlined.hs +0/−51
• Control/Monad/Sharing/Lazy/Simple.hs +0/−23
• Control/Monad/Sharing/Memoization.hs +0/−71
• Control/Monad/Trans/ContT.hs +0/−27
• List.hs +0/−35
• Setup.hs +2/−1
• Test.hs +57/−70
• explicit-sharing.cabal +6/−13

@@ -1,28 +1,136 @@-{-# LANGUAGE-     MultiParamTypeClasses,-     Rank2Types-  #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, Rank2Types #-} +-- | Module      : Control.Monad.Sharing+-- | Copyright   : Sebastian Fischer+-- | License     : PublicDomain+-- |+-- | Maintainer  : Sebastian Fischer (sebf@informatik.uni-kiel.de)+-- | Stability   : experimental+-- |+-- | This library provides an interface to monads that support explicit+-- | sharing. module Control.Monad.Sharing ( -  module Control.Monad, -  module Control.Monad.Sharing+  module Control.Monad, +  -- * Classes++  Sharing(..), Trans(..),++  -- $predefined++  -- * Evaluation++  eval,++  -- * Monadic lists++  List(..), nil, cons, isEmpty, first, rest+  ) where  import Control.Monad -class MonadPlus m => Nondet m a+-- | Interface of monads that support explicit sharing.+class Sharing m  where-  mapNondet :: (forall b . Nondet m b => m b -> m (m b)) -> a -> m a+  -- | Yields an action that returns the same results as the given+  -- | action but whose effects are only executed once. Especially,+  -- | when the resulting action is duplicated it returns the same+  -- | result at every occurrence.+  share :: Trans m a a => m a -> m (m a) -eval :: Nondet m a => a -> m a-eval = mapNondet (\a -> a >>= eval >>= return . return)+-- | Interface to transform nested monadic data types. The provided+-- | function @trans@ is supposed to map the given function on every+-- | monadic argument. The result of @trans@ may be of the same type+-- | as the argument but can also be of a different type, e.g. to+-- | convert a value with nested monadic arguments to a corresponding+-- | value without.+class Trans m a b+ where+  trans :: (forall c d . Trans m c d => m c -> m (m d)) -> a -> m b -class MonadPlus m => Sharing m+-- | Lifts all monadic effects in nested monadic values to the top+-- | level. If @m@ is a monad for non-determinism and the argument a+-- | data structure with nested non-determinism then the result+-- | corresponds to the normal form of the argument.+eval :: (Monad m, Trans m a b) => a -> m b+eval = trans (\a -> liftM return (a >>= eval))++-- $predefined +--+-- We provide instances of the @Trans@ class for some predefined+-- Haskell types. For flat types the function @trans@ just returns its+-- argument which has no arguments to which the given function could+-- be applied.++instance Monad m => Trans m Bool Bool  where-  share :: Nondet m a => m a -> m (m a)+  trans _ = return -shareRec :: (Sharing m, Nondet m a) => (m a -> m a) -> m (m a)-shareRec f = let x = share (f (x >>= id)) in x+instance Monad m => Trans m Int Int+ where+  trans _ = return++instance Monad m => Trans m Char Char+ where+  trans _ = return++instance Monad m => Trans m Float Float+ where+  trans _ = return++instance Monad m => Trans m Double Double+ where+  trans _ = return++-- | An instance for lists with monadic elements.+instance (Monad m, Trans m a a) => Trans m [m a] [m a]+ where+  trans f = mapM f++-- | An instance for lists with monadic elements that lifts all+-- | monadic effects to the top level and yields a list with+-- | non-monadic elements.+instance (Monad m, Trans m a a) => Trans m [m a] [a]+ where+  trans f = mapM (join . f)++-- | Data type for lists where both the head and tail are monadic.+data List m a = Nil | Cons (m a) (m (List m a))++-- | The empty monadic list.+nil :: Monad m => m (List m a)+nil = return Nil++-- | Constructs a non-empty monadic list.+cons :: Monad m => m a -> m (List m a) -> m (List m a)+cons x xs = return (Cons x xs)++-- | Checks if monadic list is empty.+isEmpty :: Monad m => m (List m a) -> m Bool+isEmpty ml = do l <- ml+                case l of+                  Nil      -> return True+                  Cons _ _ -> return False++-- | Yields the head of a monadic list. Relies on @MonadPlus@ instance+-- | to provide a failing implementation of @fail@.+first :: MonadPlus m => m (List m a) -> m a+first ml = do Cons x _ <- ml; x++-- | Yields the tail of a monadic list. Relies on @MonadPlus@ instance+-- | to provide a failing implementation of @fail@.+rest :: MonadPlus m => m (List m a) -> m (List m a)+rest ml = do Cons _ xs <- ml; xs++instance (Monad m, Trans m a a) => Trans m (List m a) (List m a)+ where+  trans _ Nil         = return Nil+  trans f (Cons x xs) = return Cons `ap` f x `ap` f xs++instance (Monad m, Trans m a a) => Trans m (List m a) [a]+ where+  trans _ Nil         = return []+  trans f (Cons x xs) = return (:) `ap` join (f x) `ap` join (f xs) 

@@ -1,16 +1,111 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ExistentialQuantification, +             MultiParamTypeClasses,+             FlexibleContexts,+             Rank2Types +  #-} +{-# OPTIONS -fno-warn-name-shadowing #-}++-- | Module      : Control.Monad.Sharing.Lazy+-- | Copyright   : Sebastian Fischer+-- | License     : PublicDomain+-- |+-- | Maintainer  : Sebastian Fischer (sebf@informatik.uni-kiel.de)+-- | Stability   : experimental+-- |+-- | Implements explicit sharing by passing a heap using a state monad+-- | implemented by a combination of a continuation- with a reader+-- | monad. The definitions are inlined and hand-optimized to increase+-- | performance. module Control.Monad.Sharing.Lazy ( -  Lazy, runLazy, evalLazy,+  module Control.Monad.Sharing, -  module Control.Monad.Sharing+  Lazy, evalLazy   ) where  import Control.Monad.Sharing-import Control.Monad.Sharing.Lazy.ContReaderNoThunksInlined -evalLazy :: Monad m => Nondet (Lazy m) a => Lazy m a -> m a+-- For fast and easy implementation of typed stores..+import Unsafe.Coerce++import qualified Data.IntMap as M++-- | Continuation-based, store-passing implementation of explicit+-- | sharing. It is an inlined version of @ContT (ReaderT Store m)@+-- | where the result type of continuations is polymorphic.+newtype Lazy m a = Lazy {++  -- | Runs a computation of type @Lazy m a@ with given continuation+  -- | and store.+  fromLazy :: forall w . (a -> Store -> m w) -> Store -> m w+ }++-- | Lifts all monadic effects to the top-level and unwraps the monad+-- | transformer for explicit sharing.+evalLazy :: (Monad m, Trans (Lazy m) a b) => Lazy m a -> m b evalLazy m = runLazy (m >>= eval)++-- private declarations++runLazy :: Monad m => Lazy m a -> m a+runLazy m = fromLazy m (\a _ -> return a) (Store 1 M.empty)++-- Stores consist of a fresh-reference counter and a heap represented+-- as IntMap.+data Store = Store Int (M.IntMap Untyped)++-- The monad instance is an inlined version of the instances for+-- continuation and reader monads.+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 err = Lazy (\_ _ -> fail err)++-- The @MonadPlus@ instance reuses corresponding operations of the+-- base monad.+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)++-- The @Sharing@ instance memoizes nested monadic values recursively.+instance Monad m => Sharing (Lazy m)+ where+  share = lazy++-- The more general type is necessary to please the type checker.+lazy :: (Monad m, Trans (Lazy m) a b) => Lazy m a -> Lazy m (Lazy m b)+lazy a = memo (a >>= trans lazy)++-- This is an inlined version of the following definition:+-- +-- > memo :: MonadState Store m => m a -> m (m a)+-- > memo a = do key <- getFreshKey+-- >             return $ do thunk <- lookupHNF key+-- >                         case thunk of+-- >                           Just x  -> return x+-- >                           Nothing -> do x <- a+-- >                                         insertHNF key x+-- >                                         return x+--+memo :: Lazy m a -> Lazy m (Lazy m a)+memo a = Lazy (\c (Store key heap) ->+      c (Lazy (\c s@(Store _ heap) -> +         case M.lookup key heap of+          Just x  -> c (typed x) s+          Nothing -> fromLazy a+           (\x (Store other heap) -> +              c x (Store other (M.insert key (Untyped x) heap))) s))+        (Store (succ key) heap))++-- Easy and fast hack to store typed data. An implementation using+-- Data.Typeable is possible but clutters the code with additional+-- class constraints.+data Untyped = forall a . Untyped a++typed :: Untyped -> a+typed (Untyped x) = unsafeCoerce x 

@@ -1,47 +0,0 @@-{-# 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--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, Shared False)--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

@@ -1,87 +0,0 @@-{-# 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, Shared(..), shared )--import qualified Data.IntMap as M---data Store = Store Int (M.IntMap Untyped)--getFreshKey :: MonadState Store m => m Int-getFreshKey = do-  Store key heap <- get-  put (Store (succ key) heap)-  return key--lookupHNF :: MonadState Store m => Int -> m (Maybe a)-lookupHNF key = do-  Store _ heap <- get-  return (fmap typed (M.lookup key heap))--insertHNF :: MonadState Store m => Int -> a -> m ()-insertHNF key val = do-  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, 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 $ do (x,s) <- listen a-                      if isShared s then shared (return x)-                       else mapNondet share x--memo :: (MonadState Store m, MonadWriter Shared m) => m a -> m (m a)-memo a = do-  key <- getFreshKey-  return . shared $ do-    thunk <- lookupHNF key-    case thunk of-      Just x  -> return x-      Nothing -> do-        x <- a-        insertHNF key x-        return x

@@ -1,51 +0,0 @@-{-# OPTIONS -fno-warn-name-shadowing #-}-{-# LANGUAGE-     MultiParamTypeClasses,-     Rank2Types-  #-}--module Control.Monad.Sharing.Lazy.ContReaderNoThunksInlined where--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 -> 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 (\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 -> fromLazy a (\x _ -> fromLazy (k x) c False))-  fail str = Lazy (\_ _ _ -> fail str)--instance MonadPlus m => MonadPlus (Lazy m)- where-  mzero = Lazy (\_ _ _ -> mzero)--  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 (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 b (Store key heap) ->-      c (Lazy (\c b s@(Store _ heap) -> -         case M.lookup key heap of-          Just x  -> c (typed x) True s-          Nothing -> fromLazy a-           (\x _ (Store other heap) -> -              c x True (Store other (M.insert key (Untyped x) heap))) b s))-        b (Store (succ key) heap))-

@@ -1,23 +0,0 @@-{-# 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-

@@ -1,71 +0,0 @@-{-# LANGUAGE-     ExistentialQuantification,-     FlexibleContexts-  #-}--module Control.Monad.Sharing.Memoization (--  Untyped(..), typed,--  ThunkStore(..), emptyThunkStore, Shared(..), shared, memo-- ) where--import qualified Data.IntMap as M--import Data.Monoid ()--import Control.Monad.State-import Control.Monad.Writer--import Unsafe.Coerce--data Untyped = forall a . Untyped a--typed :: Untyped -> a-typed (Untyped x) = unsafeCoerce x---data ThunkStore = ThunkStore { freshKey :: Int, thunks :: M.IntMap Untyped }--data Thunk m a = Uneval (m a) | Eval !a--emptyThunkStore :: ThunkStore-emptyThunkStore = ThunkStore { freshKey = 1, thunks = M.empty }--getFreshKey :: MonadState ThunkStore m => m Int-getFreshKey = do-  key <- gets freshKey-  modify (\s -> s { freshKey = succ key })-  return key--insertThunk :: MonadState ThunkStore m => Int -> Thunk m a -> m ()-insertThunk key thunk =-  modify (\s -> s { thunks = M.insert key (Untyped thunk) (thunks s) })--lookupThunk :: MonadState ThunkStore m => Int -> m (Thunk m a)-lookupThunk key = liftM (typed . M.findWithDefault err key) (gets thunks)- where err = error $ "lookupThunk: unbound key " ++ show key---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 . shared $ do-    thunk <- lookupThunk key-    case thunk of-      Eval x   -> return x-      Uneval b -> do-        x <- b-        insertThunk key (Eval x)-        return x

@@ -1,27 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, Rank2Types #-}--module Control.Monad.Trans.ContT where--import Control.Monad.State-import Control.Monad.Reader--newtype ContT m a = ContT { unContT :: forall w . (a -> m w) -> m w }--runContT :: Monad m => ContT m a -> m a-runContT m = unContT m return--instance MonadTrans ContT where-  lift m = ContT (\c -> m >>= c)--instance Monad m => Monad (ContT m) where-  return x = lift (return x)-  m >>=  k = ContT (\c -> unContT m (\x -> unContT (k x) c))-  fail str = lift (fail str)--instance MonadPlus m => MonadPlus (ContT m) where-  mzero       = lift mzero-  a `mplus` b = ContT (\c -> unContT a c `mplus` unContT b c)--instance Monad m => MonadState s (ContT (ReaderT s m)) where-  get   = lift ask-  put s = ContT (\c -> local (const s) (c ()))

@@ -1,35 +0,0 @@-{-# LANGUAGE-     NoMonomorphismRestriction,-     MultiParamTypeClasses,-     FlexibleInstances-  #-}--module List where --import Control.Monad.Sharing.Lazy--data List m a = Nil | Cons (m a) (m (List m a))--nil = return Nil-cons x xs = return (Cons x xs)--match n _ Nil = n-match _ c (Cons x xs) = c x xs--empty l = l >>= match (return True) (\_ _ -> return False)-first l = l >>= match mzero const-rest  l = l >>= match mzero (flip const)--fold n c l = l >>= match n (\x xs -> c x (fold n c xs))--instance Nondet m a => Nondet m (List m a)- where-  mapNondet _ Nil         = return Nil-  mapNondet f (Cons x xs) = do-    y  <- f x-    ys <- f xs-    return (Cons y ys)--instance MonadPlus m => Nondet m Int- where-  mapNondet _ = return

@@ -5,5 +5,6 @@ main = defaultMainWithHooks $ simpleUserHooks { runTests = runTestSuite }  runTestSuite _ _ _ _ =- runCommand "runhaskell Test.hs" >>= waitForProcess >>= exitWith+ do pid <- runCommand "ghc -hide-package monads-fd -e main Test.hs"+    waitForProcess pid >>= exitWith 

@@ -1,14 +1,13 @@ {-# LANGUAGE      NoMonomorphismRestriction,      MultiParamTypeClasses,+     OverlappingInstances,      FlexibleInstances,      FlexibleContexts   #-}  import Control.Monad.Sharing.Lazy -import List- main = do   putStr "failing tests: "   print . map fst . filter (not . snd) . zip [1..] $ tests@@ -16,32 +15,30 @@   tests = [ dup_coin_let, dup_coin_bind, dup_coin_share           , lazy_share, heads_bind, heads_share, dup_first_coin           , one_coin, two_coins, dup_coin, dupnot_coin-          , first_rep, first_rep', rep_coin, rep_coin'-          , dup_list, ignore_shared, empty_rep, empty_rep'+          , first_rep, rep_coin+          , dup_list, ignore_shared, empty_rep           , nest_lazy, nest_share1, nest_share2           , dup_dup, dup_two_coins, dup_head, dup_head_lazy           ] -instance MonadPlus m => Nondet m Bool+instance Monad m => Trans m (Int,Int) (Int,Int)  where-  mapNondet _ = return+  trans _ = return -instance MonadPlus m => Nondet m (Int,Int)- where-  mapNondet _ = return+-- instance (Trans m a a, Trans m b b) => Trans m (m a,m b) (m a,m b)+--  where+--   trans f (a,b) = return (,) `ap` f a `ap` f b -instance (Nondet m a, Nondet m b) => Nondet m (m a,m b)+instance Monad m => Trans m (m Int, m Int) (m Int, m Int)  where-  mapNondet f (a,b) = return (,) `ap` f a `ap` f b--fromList _ Nil         = return []-fromList f (Cons x xs) = do y <- x >>= f; ys <- xs >>= fromList f; return (y:ys)+  trans f (a,b) = return (,) `ap` f a `ap` f b -fromPair l r (a,b) = do x <- a >>= l; y <- b >>= r; return (x,y)+instance (Monad m, Trans m a c, Trans m b d) => Trans m (m a,m b) (c,d)+ where+  trans f (a,b) = return (,) `ap` join (f a) `ap` join (f b) -assertEqual :: (Nondet (Lazy []) a, Eq b)-            => (a -> Lazy [] b) -> [b] -> Lazy [] a -> Bool-assertEqual f res test = zipEq (runLazy (test >>= eval >>= f)) res+assertEqual :: (Trans (Lazy []) a b, Eq b) => [b] -> Lazy [] a -> Bool+assertEqual res test = zipEq (evalLazy test) res  where   zipEq [] [] = True   zipEq [] _  = False@@ -51,25 +48,19 @@ coin :: MonadPlus m => m Int coin = return 0 `mplus` return 1 -ilist = fromList return-illist = fromList ilist-ipair = fromPair return return-pilist = fromPair ilist ilist-ippair = fromPair ipair ipair- -- examples from paper  duplicate :: Monad m => m a -> m (a,a) duplicate a = do x <- a; y <- a; return (x,y) -dup_coin_let = assertEqual return [(0,0),(0,1),(1,0),(1,1)] $ +dup_coin_let = assertEqual [(0,0)::(Int,Int),(0,1),(1,0),(1,1)] $                   let x = coin in duplicate x -dup_coin_bind  = assertEqual return [(0,0),(1,1)] $ do+dup_coin_bind  = assertEqual [(0,0)::(Int,Int),(1,1)] $ do                    x <- coin                    duplicate (return x) -dup_coin_share = assertEqual return [(0,0),(1,1)] $ do+dup_coin_share = assertEqual [(0,0)::(Int,Int),(1,1)] $ do                    x <- share coin                    duplicate x @@ -77,107 +68,103 @@ --   do x <- undefined :: Lazy [] Int --      duplicate (const (return 2) (return x)) -lazy_share = assertEqual return [(2::Int,2::Int)] $+lazy_share = assertEqual [(2::Int,2::Int)] $   do x <- share (undefined :: Lazy [] Int)-     duplicate (const (return 2) x)+     duplicate (const (return (2::Int)) x)  dupl :: Monad m => m a -> m (List m a) dupl x = cons x (cons x nil) -heads_bind = assertEqual ilist [[0,0],[0,1],[1,0],[1,1]] $ do+heads_bind = assertEqual [[0,0::Int],[0,1],[1,0],[1,1]] $ do                x <- cons coin undefined 	       dupl (first (return x)) -heads_share = assertEqual ilist [[0,0],[1,1]] $ do+heads_share = assertEqual [[0,0::Int],[1,1]] $ do                 x <- share (cons coin undefined)                 dupl (first x)  coins :: MonadPlus m => m (List m Int) coins = nil `mplus` cons coin coins -dup_first_coin = assertEqual ilist [[0,0],[1,1]] $ do+dup_first_coin = assertEqual [[0::Int,0],[1,1]] $ do                    cs <- share coins                    dupl (first cs)  -- other examples -one_coin = assertEqual return [0,1] coin+one_coin = assertEqual [0,1::Int] coin -two_coins = assertEqual ipair [(0,0),(0,1),(1,0),(1,1)] $ return (coin,coin)+two_coins = assertEqual [(0,0),(0::Int,1::Int),(1,0),(1,1)] $+              return (coin :: Lazy [] Int, coin :: Lazy [] Int) -dup_coin = assertEqual ipair [(0,0),(1,1)] $ dup coin+dup_coin = assertEqual [(0::Int,0::Int),(1,1)] $ dup coin +dup :: (Monad m, Sharing m, Trans m a a) => m a -> m (m a, m a) dup a = do   x <- share a   return (x,x) -dupnot_coin = assertEqual ipair [(1,1),(0,0)] $ dupnot coin+dupnot_coin = assertEqual [(1::Int,1::Int),(0,0)] $ dupnot coin  dupnot a = do   x <- share a   return (liftM ((-)1) x, liftM ((-)1) x) -first_rep = assertEqual return [42::Int] $ first (first (rep (rep (return 42))))+first_rep = assertEqual [42::Int] $ +              first (first (rep (rep (return (42::Int)))))  rep a = do   x <- share a   cons x (rep x) -first_rep' = assertEqual return [42::Int] $-               first (first (rep' (rep' (return 42))))--rep' a = do-  xs <- shareRec (\l -> cons a l)-  xs--rep_coin = assertEqual ipair [(0::Int,0::Int),(1,1)] $-             rep coin >>= match mzero (\x xs -> return (x, first xs))---- recursive bindings do not work as expected:-rep_coin' = assertEqual ipair [(0::Int,0::Int),(0,1),(1,0),(1,1)] $-              rep' coin >>= match mzero (\x xs -> return (x, first xs))+rep_coin = assertEqual [(0::Int,0::Int),(1,1)] $ do+             Cons x xs <- rep coin+             return (x, first xs) -dup_list = assertEqual pilist [([],[])-                              ,([0],[0])-                              ,([0,0],[0,0])-                              ,([0,0,0],[0,0,0])] $+dup_list = assertEqual [([],[])+                       ,([0::Int],[0::Int])+                       ,([0,0],[0,0])+                       ,([0,0,0],[0,0,0])] $              dup coins -ignore_shared = assertEqual ipair [(0,1)] $ ign_pair mzero+ignore_shared = assertEqual [(0::Int,1::Int)] $ ign_pair mzero -ign_pair :: Sharing m => m Int -> m (m Int,m Int)+ign_pair :: Lazy [] Int -> Lazy [] (Lazy [] Int,Lazy [] Int) ign_pair a = do-  x <- share a+  x <- share (a :: Lazy [] Int)   return (const (return 0) x, const (return 1) x) -empty_rep = assertEqual return [False] $ empty (rep (undefined::Lazy [] Int))--empty_rep' = assertEqual return [False] $ empty (rep' (undefined::Lazy [] Int))+empty_rep = assertEqual [False] $ isEmpty (rep (undefined::Lazy [] Int)) -nest_lazy = assertEqual return [42::Int] $ do+nest_lazy = assertEqual [42::Int] $ do   x <- share (cons (return 42) mzero)-  first x+  first x :: Lazy [] Int -nest_share1 = assertEqual ipair [(0,0),(1,1)] $ do+nest_share1 = assertEqual [(0::Int,0::Int),(1,1)] $ do   x <- share (share (return True) >> coin)   return (x,x) -nest_share2 = assertEqual ipair [(0,0),(1,1)] $ do+nest_share2 = assertEqual [(0::Int,0::Int),(1,1)] $ do   x <- share (share coin >>= id)   return (x,x) -dup_dup = assertEqual ippair [((0,0),(0,0)),((1,1),(1,1))] $ dup (dup coin)+dup_dup = assertEqual [((0::Int,0::Int),(0::Int,0::Int)),((1,1),(1,1))] $ +            (dup (dup coin :: Lazy [] (Lazy [] Int,Lazy [] Int))+              :: Lazy [] (Lazy [] (Lazy [] Int,Lazy [] Int),+                          Lazy [] (Lazy [] Int,Lazy [] Int))) -dup_two_coins = assertEqual ippair [((0,0),(0,0)),((0,1),(0,1))-                                   ,((1,0),(1,0)),((1,1),(1,1))] $ do+dup_two_coins = assertEqual [((0::Int,0::Int),(0::Int,0::Int)),((0,1),(0,1))+                            ,((1,0),(1,0)),((1,1),(1,1))] $ do   x <- share coin   y <- share coin-  return (return (x,y), return (x,y))+  return ( return (x,y) :: Lazy [] (Lazy [] Int, Lazy [] Int)+         , return (x,y) :: Lazy [] (Lazy [] Int, Lazy [] Int)) -dup_head = assertEqual ipair [(0,0),(1,1)] $ heads (cons coin nil)+dup_head = assertEqual [(0::Int,0::Int),(1,1)] $ heads (cons coin nil)  heads l = do   xs <- share l   return (first xs, first xs) -dup_head_lazy = assertEqual ipair [(0,0),(1,1)] $ heads (cons coin undefined)+dup_head_lazy = assertEqual [(0::Int,0::Int),(1,1)] $+                  heads (cons coin undefined)

@@ -1,36 +1,29 @@ Name:          explicit-sharing-Version:       0.2+Version:       0.3.1 Cabal-Version: >= 1.6 Synopsis:      Explicit Sharing of Monadic Effects Description:       This package implements a monad transformer for sharing monadic-  effects of monads for non-determinism.+  effects.  Category:      Control, Monads License:       PublicDomain License-File:  LICENSE Author:        Chung-chieh Shan, Oleg Kiselyov, and Sebastian Fischer Maintainer:    sebf@informatik.uni-kiel.de-Bug-Reports:   mailto:sebf@informatik.uni-kiel.de+Bug-Reports:   http://github.com/sebfisch/explicit-sharing/issues Build-Type:    Custom Stability:     experimental -Extra-Source-Files: Test.hs, List.hs+Extra-Source-Files: Test.hs  Library   Build-Depends:    base, containers, mtl-  Exposed-Modules:  Control.Monad.Trans.ContT,-                    Control.Monad.Sharing,+  Exposed-Modules:  Control.Monad.Sharing,                     Control.Monad.Sharing.Lazy-                    Control.Monad.Sharing.Lazy.Simple,-                    Control.Monad.Sharing.Lazy.ContReader,-                    Control.Monad.Sharing.Lazy.ContReaderNoThunks,-                    Control.Monad.Sharing.Lazy.ContReaderNoThunksInlined-  Other-Modules:    Control.Monad.Sharing.Memoization   Ghc-Options:      -Wall-  Extensions:       GeneralizedNewtypeDeriving,-                    ExistentialQuantification,+  Extensions:       ExistentialQuantification,                     MultiParamTypeClasses,                     FlexibleInstances,                     FlexibleContexts,