explicit-sharing 0.4.0.1 → 0.5.0

raw patch · 8 files changed

+310/−105 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Control/Monad/Sharing.hs +3/−3
• Control/Monad/Sharing/Classes.hs +76/−51
• Control/Monad/Sharing/FirstOrder.hs +28/−0
• Control/Monad/Sharing/Implementation/CPS.hs +42/−23
• Control/Monad/Sharing/Implementation/FirstOrder.hs +120/−0
• Data/Monadic/List.hs +15/−15
• Test.hs +20/−11
• explicit-sharing.cabal +6/−2

@@ -14,7 +14,7 @@    -- * Classes -  Sharing(..), Trans(..), eval,+  Sharing(..), Shareable(..), Convertible(..), convert,    -- * Monad transformer @@ -23,5 +23,5 @@  ) where  import Control.Monad-import Control.Monad.Sharing.Classes            ( Sharing(..), Trans(..), eval )-import Control.Monad.Sharing.Implementation.CPS ( Lazy, evalLazy )+import Control.Monad.Sharing.Classes+import Control.Monad.Sharing.Implementation.CPS

@@ -1,4 +1,9 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, Rank2Types #-}+{-# LANGUAGE+      MultiParamTypeClasses,+      FlexibleInstances,+      FlexibleContexts,+      Rank2Types+  #-}  -- |  -- Module      : Control.Monad.Sharing.Classes@@ -14,12 +19,10 @@ -- sharing. module Control.Monad.Sharing.Classes ( -  Sharing(..), Trans(..), eval+  Sharing(..), Shareable(..), Convertible(..), convert   ) where -import Control.Monad ( liftM, join )- -- | Interface of monads that support explicit sharing. class Sharing m  where@@ -28,81 +31,103 @@   -- 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)+  share :: Shareable m a => m a -> m (m a)  -- |--- 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.+-- Interface of shareable nested monadic data types. The provided+-- function 'shareArgs' is supposed to map the given function on every+-- monadic argument. -- --- 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.-class Trans m a b+-- We provide instances of the 'Shareable' class for some predefined+-- Haskell types. For flat types the function 'shareArgs' just returns+-- its argument which has no arguments to which the given function+-- could be applied.+class Shareable m a  where-  trans :: (forall c d . Trans m c d => m c -> m (m d)) -> a -> m b+  shareArgs :: Monad n +            => (forall b . Shareable m b => m b -> n (m b)) -> a -> n a --- |--- 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))+instance Monad m => Shareable m Bool+ where+  shareArgs _ = return -instance Monad m => Trans m Bool Bool+instance Monad m => Shareable m Int  where-  trans _ = return+  shareArgs _ = return -instance Monad m => Trans m Int Int+instance Monad m => Shareable m Char  where-  trans _ = return+  shareArgs _ = return -instance Monad m => Trans m Char Char+instance Monad m => Shareable m [Bool]  where-  trans _ = return+  shareArgs _ = return -instance Monad m => Trans m Float Float+instance Monad m => Shareable m [Int]  where-  trans _ = return+  shareArgs _ = return -instance Monad m => Trans m Double Double+instance Monad m => Shareable m [Char]  where-  trans _ = return+  shareArgs _ = return -instance Monad m => Trans m [Bool] [Bool]+-- | An instance for lists with monadic elements.+instance (Monad m, Shareable m a) => Shareable m [m a]  where-  trans _ = return+  shareArgs f = mapM f -instance Monad m => Trans m [Int] [Int]+-- |+-- Interface for convertible datatypes. The provided function+-- 'convArgs' is supposed to map the given function on every argument+-- of the given value and combine the results to give the converted+-- value.+-- +-- We provide instances of the 'Convertible' class for some predefined+-- Haskell types. For flat types the function 'convArgs' just returns+-- its argument which has no arguments to which the given function+-- could be applied.+class Convertible m a b  where-  trans _ = return+  convArgs :: (forall c d . Convertible m c d => c -> m d) -> a -> m b -instance Monad m => Trans m [Char] [Char]+-- | Converts a convertible value recursively.+convert :: Convertible m a b => a -> m b+convert = convArgs convert++instance Monad m => Convertible m Bool Bool  where-  trans _ = return+  convArgs _ = return -instance Monad m => Trans m [Float] [Float]+instance Monad m => Convertible m Int Int  where-  trans _ = return+  convArgs _ = return -instance Monad m => Trans m [Double] [Double]+instance Monad m => Convertible m Char Char  where-  trans _ = return+  convArgs _ = return --- | An instance for lists with monadic elements.-instance (Monad m, Trans m a a) => Trans m [m a] [m a]+instance Monad m => Convertible m [Bool] [Bool]  where-  trans f = mapM f+  convArgs _ = return +instance Monad m => Convertible m [Int] [Int]+ where+  convArgs _ = return++instance Monad m => Convertible m [Char] [Char]+ where+  convArgs _ = return+ -- |--- An instance for lists with monadic elements that lifts all monadic--- effects to the top level and yields a list with non-monadic+-- An instance to convert ordinary lists into lists with monadic -- elements.-instance (Monad m, Trans m a a) => Trans m [m a] [a]+instance (Monad m, Convertible m a b) => Convertible m [a] [m b]  where-  trans f = mapM (join . f)+  convArgs f = return . map f++-- |+-- An instance to convert lists with monadic elements into ordinary+-- lists.+instance (Monad m, Convertible m a b) => Convertible m [m a] [b]+ where+  convArgs f = mapM (>>=f)

@@ -0,0 +1,28 @@+-- | +-- Module      : Control.Monad.Sharing.FirstOrder+-- Copyright   : Chung-chieh Shan, Oleg Kiselyov, and Sebastian Fischer+-- License     : PublicDomain+-- Maintainer  : Sebastian Fischer <mailto:sebf@informatik.uni-kiel.de>+-- Stability   : experimental+-- +-- This library provides an interface to monads that support explicit+-- sharing based on two-level types. This implementation is not as+-- efficient as the default implementation but it avoids duplicate+-- sharing which can lead to exponential blowup of the threaded heap.+module Control.Monad.Sharing.FirstOrder (++  module Control.Monad,++  -- * Classes++  Sharing(..), Shareable(..), Convertible(..), convert,++  -- * Monad transformer++  Lazy, evalLazy++ ) where++import Control.Monad+import Control.Monad.Sharing.Classes+import Control.Monad.Sharing.Implementation.FirstOrder

@@ -1,7 +1,7 @@-{-# LANGUAGE ExistentialQuantification, +{-# LANGUAGE ExistentialQuantification,              MultiParamTypeClasses,              FlexibleContexts,-             Rank2Types +             Rank2Types   #-}  {-# OPTIONS -fno-warn-name-shadowing #-}@@ -10,23 +10,27 @@ -- Module      : Control.Monad.Sharing.Implementation.CPS -- Copyright   : Chung-chieh Shan, Oleg Kiselyov, and Sebastian Fischer -- License     : PublicDomain--- Maintainer  : Sebastian Fischer (sebf\@informatik.uni-kiel.de)+-- Maintainer  : Sebastian Fischer <mailto: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.Implementation.CPS ( -  Lazy, evalLazy+  Lazy, evalLazy, runLazy, +  Store, emptyStore, freshLabel, lookupValue, storeValue+  ) where -import Control.Monad                 ( MonadPlus(..) )-import Control.Monad.Trans           ( MonadTrans(..), MonadIO(..) )-import Control.Monad.Sharing.Classes ( Sharing(..), Trans(..), eval )+import Control.Monad       ( MonadPlus(..) )+import Control.Monad.State ( MonadState(..), gets, modify )+import Control.Monad.Trans ( MonadTrans(..), MonadIO(..) ) +import Control.Monad.Sharing.Classes+ -- For fast and easy implementation of typed stores.. import Unsafe.Coerce @@ -47,18 +51,32 @@ -- | -- 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)+evalLazy :: (Monad m, Convertible (Lazy m) a b) => Lazy m a -> m b+evalLazy m = runLazy (m >>= convert)  -- private declarations  runLazy :: Monad m => Lazy m a -> m a-runLazy m = fromLazy m (\a _ -> return a) (Store 1 M.empty)+runLazy m = fromLazy m (\a _ -> return a) emptyStore  -- Stores consist of a fresh-reference counter and a heap represented -- as IntMap.-data Store = Store Int (M.IntMap Untyped)+data Store = Store { nextLabel :: Int, heap :: M.IntMap Untyped } +emptyStore :: Store+emptyStore = Store 1 M.empty++freshLabel :: MonadState Store m => m Int+freshLabel = do s <- get+                put (s { nextLabel = nextLabel s + 1 })+                return (nextLabel s)++lookupValue :: MonadState Store m => Int -> m (Maybe a)+lookupValue k = gets (fmap typed . M.lookup k . heap)++storeValue :: MonadState Store m => Int -> a -> m ()+storeValue k v = modify (\s -> s { heap = M.insert k (Untyped v) (heap s) })+ -- The monad instance is an inlined version of the instances for -- continuation and reader monads. instance Monad m => Monad (Lazy m)@@ -67,14 +85,20 @@   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+-- 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) --- @Lazy@ is a monad transformer.+-- A Cont/Reader monad is an instance of MonadState+instance Monad m => MonadState Store (Lazy m)+ where+  get   = Lazy (\c s -> c s s)+  put s = Lazy (\c _ -> c () s)++-- 'Lazy' is a monad transformer. instance MonadTrans Lazy  where   lift a = Lazy (\c s -> a >>= \x -> c x s)@@ -84,24 +108,19 @@  where   liftIO = lift . liftIO --- 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)+  share a = memo (a >>= shareArgs share)  -- 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+-- > memo a = do key <- freshLabel+-- >             return $ do thunk <- lookupValue key -- >                         case thunk of -- >                           Just x  -> return x -- >                           Nothing -> do x <- a--- >                                         insertHNF key x+-- >                                         storeValue key x -- >                                         return x -- memo :: Lazy m a -> Lazy m (Lazy m a)

@@ -0,0 +1,120 @@+{-# LANGUAGE ExistentialQuantification, +             MultiParamTypeClasses,+             FlexibleContexts,+             RelaxedPolyRec+  #-}++-- | +-- Module      : Control.Monad.Sharing.Implementation.FirstOrder+-- Copyright   : Chung-chieh Shan, Oleg Kiselyov, and Sebastian Fischer+-- License     : PublicDomain+-- Maintainer  : Sebastian Fischer <mailto:sebf@informatik.uni-kiel.de>+-- Stability   : experimental+-- +-- Implements a monad transformer for explicit sharing.+module Control.Monad.Sharing.Implementation.FirstOrder (++  Lazy, evalLazy++ ) where++import Control.Monad       ( MonadPlus(..) )+-- import Control.Monad.State ( MonadState(..), StateT, evalStateT )+import Control.Monad.Trans ( MonadTrans(..), MonadIO(..) )++import Control.Monad.Sharing.Classes++import qualified Control.Monad.Sharing.Implementation.CPS as CPS+import Control.Monad.Sharing.Implementation.CPS+ ( -- Store, emptyStore, +   freshLabel, lookupValue, storeValue )++-- | +-- Monad transformer that adds explicit sharing capability to every+-- monad.+newtype Lazy m a = Lazy { fromLazy :: m (Labeled m a) }++-- |+-- Lifts all monadic effects to the top-level and unwraps the monad+-- transformer for explicit sharing.+evalLazy :: (Monad m, Shareable (Lazy m) a, Convertible (Lazy m) a b)+         => Lazy m a -> m b+evalLazy m = do Lifted a <- fromLazy (evalS (gnf m) >>= convert)+                return a++-- type S m a = StateT Store m a+type S m a = CPS.Lazy m a++evalS :: Monad m => S m a -> m a+-- evalS m = evalStateT m emptyStore+evalS m = CPS.runLazy m++-- using 'CPS.Lazy' instead of 'StateT Store' is almost twice as fast.++-- private declarations             ++data Labeled m a+  = Lifted a+  | WithFresh (Int -> Lazy m a)+  | forall b . Shareable (Lazy m) b => Labeled Int (Lazy m b) (b -> Lazy m a)+++gnf :: (Monad m, Shareable (Lazy m) a) => Lazy m a -> S (Lazy m) a+gnf a = hnf a >>= shareArgs (\b -> gnf b >>= return . return)++hnf :: Monad m => Lazy m a -> S (Lazy m) a+hnf m = run =<< lift (lift (fromLazy m))++run :: Monad m => Labeled m a -> S (Lazy m) a+run (Lifted a)      = return a+run (WithFresh f)   = hnf . f =<< freshLabel+run (Labeled n a f) = do thunk <- lookupValue n+                         case thunk of+                           Just c  -> hnf (f c)+                           Nothing -> do x <- labelArgs a+                                         storeValue n x+                                         hnf (f x)++labelArgs :: (Monad m, Shareable (Lazy m) a) => Lazy m a -> S (Lazy m) a+labelArgs a = hnf a >>= shareArgs (\x -> do n <- freshLabel+                                            return (setLabel n x.:a))++-- some type trickery to identify monads+(.:) :: Lazy m a -> Lazy m b -> Lazy m a+(.:) = const++setLabel :: (Monad m, Shareable (Lazy m) a) => Int -> Lazy m a -> Lazy m a+setLabel n x = Lazy (return (Labeled n x return))++instance Monad m => Monad (Lazy m)+ where+  return  = Lazy . return . Lifted+  a >>= k = Lazy (fromLazy a >>= bind k)+  fail    = Lazy . fail++bind :: Monad m => (a -> Lazy m b) -> Labeled m a -> m (Labeled m b)+bind k (Lifted a)      = fromLazy (k a)+bind k (WithFresh f)   = return (WithFresh (\n -> f n >>= k))+bind k (Labeled n m f) = return (Labeled n m (\x -> f x >>= k))++-- The 'MonadPlus' instance reuses corresponding operations of the+-- base monad.+instance MonadPlus m => MonadPlus (Lazy m)+ where+  mzero       = Lazy mzero+  a `mplus` b = Lazy (fromLazy a `mplus` fromLazy b)++-- 'Lazy t' is a monad transformer.+instance MonadTrans Lazy+ where+  lift a = Lazy (a >>= return . Lifted)++-- If the underlying monad supports IO we can lift this functionality.+instance MonadIO m => MonadIO (Lazy m)+ where+  liftIO = lift . liftIO++-- The @Sharing@ instance introduces the internal sharing constructors.+instance Monad m => Sharing (Lazy m)+ where+  share a = Lazy (return (WithFresh (\n -> return (setLabel n a))))

@@ -16,8 +16,8 @@   ) where -import Control.Monad                 ( MonadPlus, ap, join )-import Control.Monad.Sharing.Classes ( Trans(..) )+import Control.Monad                 ( MonadPlus, ap )+import Control.Monad.Sharing.Classes ( Shareable(..), Convertible(..) )  -- | Data type for lists where both the head and tail are monadic. data List m a = Nil | Cons (m a) (m (List m a))@@ -52,23 +52,23 @@ -- | -- This instance allows to use nested monadic lists as argument to the -- 'Control.Monad.Sharing.share' combinator.-instance (Monad m, Trans m a b) => Trans m (List m a) (List m b)+instance (Monad m, Shareable m a) => Shareable m (List m a)  where-  trans _ Nil         = return Nil-  trans f (Cons x xs) = return Cons `ap` f x `ap` f xs+  shareArgs _ Nil         = return Nil+  shareArgs f (Cons x xs) = return Cons `ap` f x `ap` f xs  -- |--- This instance enables the function 'Control.Monad.Sharing.eval' to--- transform nested monadic lists into ordinary Haskell lists.-instance (Monad m, Trans m a b) => Trans m (List m a) [b]+-- This instance enables the function 'Control.Monad.Sharing.convert'+-- to transform ordinary Haskell lists into nested monadic lists.+instance (Monad m, Convertible m a b) => Convertible m [a] (List m b)  where-  trans _ Nil         = return []-  trans f (Cons x xs) = return (:) `ap` join (f x) `ap` join (f xs)+  convArgs _ []     = return Nil+  convArgs f (x:xs) = return (Cons (f x) (f xs))  -- |--- This instance enables the function 'Control.Monad.Sharing.eval' to--- transform ordinary Haskell lists into nested monadic lists.-instance (Monad m, Trans m a b) => Trans m [a] (List m b)+-- This instance enables the function 'Control.Monad.Sharing.convert'+-- to transform nested monadic lists into ordinary Haskell lists.+instance (Monad m, Convertible m a b) => Convertible m (List m a) [b]  where-  trans _ []     = return Nil-  trans f (x:xs) = return Cons `ap` f (return x) `ap` f (return xs)+  convArgs _ Nil         = return []+  convArgs f (Cons x xs) = return (:) `ap` (x >>= f) `ap` (xs >>= f)

@@ -22,23 +22,32 @@           , dup_dup, dup_two_coins, dup_head, dup_head_lazy           ] -instance Monad m => Trans m (Int,Int) (Int,Int)+instance Monad m => Shareable m (Int,Int)  where-  trans _ = return+  shareArgs _ = 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 Monad m => Shareable m ([Int],[Int])+ where+  shareArgs _ = return -instance Monad m => Trans m (m Int, m Int) (m Int, m Int)+instance Monad m => Shareable m ((Int,Int),(Int,Int))  where-  trans f (a,b) = return (,) `ap` f a `ap` f b+  shareArgs _ = return -instance (Monad m, Trans m a c, Trans m b d) => Trans m (m a,m b) (c,d)+instance Monad m => Convertible m (Int,Int) (Int,Int)  where-  trans f (a,b) = return (,) `ap` join (f a) `ap` join (f b)+  convArgs _ = return -assertEqual :: (Trans (Lazy []) a b, Eq b) => [b] -> Lazy [] a -> Bool+instance (Monad m, Shareable m a) => Shareable m (m a, m a)+ where+  shareArgs f (x,y) = return (,) `ap` f x `ap` f y++instance (Monad m, Convertible m a b) => Convertible m (m a, m a) (b, b)+ where+  convArgs f (x,y) = return (,) `ap` (x >>= f) `ap` (y >>= f)++assertEqual :: (Shareable (Lazy []) a, Convertible (Lazy []) a b, Eq b)+            => [b] -> Lazy [] a -> Bool assertEqual res test = zipEq (evalLazy test) res  where   zipEq [] [] = True@@ -100,7 +109,7 @@  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 :: (Monad m, Sharing m, Shareable m a) => m a -> m (m a, m a) dup a = do   x <- share a   return (x,x)

@@ -1,5 +1,5 @@ Name:          explicit-sharing-Version:       0.4.0.1+Version:       0.5.0 Cabal-Version: >= 1.6 Synopsis:      Explicit Sharing of Monadic Effects Description:   @@ -12,6 +12,7 @@ License-File:  LICENSE Author:        Chung-chieh Shan, Oleg Kiselyov, and Sebastian Fischer Maintainer:    sebf@informatik.uni-kiel.de+Homepage:      http://sebfisch.github.com/explicit-sharing Bug-Reports:   http://github.com/sebfisch/explicit-sharing/issues Build-Type:    Custom Stability:     experimental@@ -22,11 +23,14 @@   Build-Depends:    base, containers ==0.2.0.0, mtl   Exposed-Modules:  Control.Monad.Sharing,                     Control.Monad.Sharing.Classes,+                    Control.Monad.Sharing.FirstOrder,                     Data.Monadic.List-  Other-Modules:    Control.Monad.Sharing.Implementation.CPS+  Other-Modules:    Control.Monad.Sharing.Implementation.CPS,+                    Control.Monad.Sharing.Implementation.FirstOrder   Ghc-Options:      -Wall   Extensions:       ExistentialQuantification,                     MultiParamTypeClasses,                     FlexibleInstances,                     FlexibleContexts,+                    RelaxedPolyRec,                     Rank2Types