diff --git a/Control/Monad/Ref.hs b/Control/Monad/Ref.hs --- a/Control/Monad/Ref.hs +++ b/Control/Monad/Ref.hs @@ -1,15 +1,17 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} + -- | -- Module : Control.Monad.Ref -- Copyright : (c) Harvard University 2006-2011 --- (c) Geoffrey Mainland 2011-2012 +-- (c) Geoffrey Mainland 2011-2014 -- License : BSD-style --- Maintainer : mainland@eecs.harvard.edu +-- Maintainer : Geoffrey Mainland -- -- Stability : experimental -- Portability : non-portable -{-# LANGUAGE TypeFamilies #-} - module Control.Monad.Ref ( MonadRef(..), MonadAtomicRef(..) @@ -23,6 +25,9 @@ import Control.Monad.ST (ST) import Control.Monad.Trans.Cont (ContT) import Control.Monad.Trans.Error (ErrorT, Error) +#if MIN_VERSION_transformers(0,4,0) +import Control.Monad.Trans.Except (ExceptT) +#endif /* MIN_VERSION_transformers(0,4,0) */ import Control.Monad.Trans.Identity (IdentityT) import Control.Monad.Trans.List (ListT) import Control.Monad.Trans.Maybe (MaybeT) @@ -33,6 +38,10 @@ import Control.Monad.Trans.Writer.Strict as Strict (WriterT) import Control.Monad.Trans.Class (lift) import Data.IORef (IORef, +#if MIN_VERSION_base(4,6,0) + atomicModifyIORef', + modifyIORef', +#endif /* MIN_VERSION_base(4,6,0) */ atomicModifyIORef, modifyIORef, newIORef, @@ -40,6 +49,9 @@ writeIORef) import Data.Monoid (Monoid) import Data.STRef (STRef, +#if MIN_VERSION_base(4,6,0) + modifySTRef', +#endif /* MIN_VERSION_base(4,6,0) */ modifySTRef, newSTRef, readSTRef, @@ -61,26 +73,43 @@ -- |Mutate the contents of a reference modifyRef :: Ref m a -> (a -> a) -> m () modifyRef r f = readRef r >>= writeRef r . f + -- |Strict version of 'modifyRef' + modifyRef' :: Ref m a -> (a -> a) -> m () + modifyRef' r f = readRef r >>= \x -> let x' = f x in x' `seq` writeRef r x' class (MonadRef m) => MonadAtomicRef m where -- |Atomically mutate the contents of a reference atomicModifyRef :: Ref m a -> (a -> (a, b)) -> m b + -- |Strict version of atomicModifyRef. This forces both the value stored in + -- the reference as well as the value returned. + atomicModifyRef' :: Ref m a -> (a -> (a, b)) -> m b + atomicModifyRef' r f = do + b <- atomicModifyRef r + (\x -> let (a, b) = f x + in (a, a `seq` b)) + b `seq` return b instance MonadRef (ST s) where type Ref (ST s) = STRef s - newRef = newSTRef - readRef = readSTRef - writeRef = writeSTRef - modifyRef = modifySTRef + newRef = newSTRef + readRef = readSTRef + writeRef = writeSTRef + modifyRef = modifySTRef +#if MIN_VERSION_base(4,6,0) + modifyRef' = modifySTRef' +#endif /* MIN_VERSION_base(4,6,0) */ instance MonadRef IO where type Ref IO = IORef - newRef = newIORef - readRef = readIORef - writeRef = writeIORef - modifyRef = modifyIORef + newRef = newIORef + readRef = readIORef + writeRef = writeIORef + modifyRef = modifyIORef +#if MIN_VERSION_base(4,6,0) + modifyRef' = modifyIORef' +#endif /* MIN_VERSION_base(4,6,0) */ instance MonadRef STM where type Ref STM = TVar @@ -92,85 +121,109 @@ instance MonadRef m => MonadRef (ContT r m) where type Ref (ContT r m) = Ref m - newRef r = lift $ newRef r - readRef r = lift $ readRef r - writeRef r x = lift $ writeRef r x - modifyRef r f = lift $ modifyRef r f + newRef r = lift $ newRef r + readRef r = lift $ readRef r + writeRef r x = lift $ writeRef r x + modifyRef r f = lift $ modifyRef r f + modifyRef' r f = lift $ modifyRef' r f instance (Error e, MonadRef m) => MonadRef (ErrorT e m) where type Ref (ErrorT e m) = Ref m - newRef r = lift $ newRef r - readRef r = lift $ readRef r - writeRef r x = lift $ writeRef r x - modifyRef r f = lift $ modifyRef r f + newRef r = lift $ newRef r + readRef r = lift $ readRef r + writeRef r x = lift $ writeRef r x + modifyRef r f = lift $ modifyRef r f + modifyRef' r f = lift $ modifyRef' r f +#if MIN_VERSION_transformers(0,4,0) +instance (MonadRef m) => MonadRef (ExceptT e m) where + type Ref (ExceptT e m) = Ref m + + newRef r = lift $ newRef r + readRef r = lift $ readRef r + writeRef r x = lift $ writeRef r x + modifyRef r f = lift $ modifyRef r f + modifyRef' r f = lift $ modifyRef' r f +#endif /* MIN_VERSION_transformers(0,4,0) */ + instance MonadRef m => MonadRef (IdentityT m) where type Ref (IdentityT m) = Ref m - newRef r = lift $ newRef r - readRef r = lift $ readRef r - writeRef r x = lift $ writeRef r x - modifyRef r f = lift $ modifyRef r f + newRef r = lift $ newRef r + readRef r = lift $ readRef r + writeRef r x = lift $ writeRef r x + modifyRef r f = lift $ modifyRef r f + modifyRef' r f = lift $ modifyRef' r f instance MonadRef m => MonadRef (ListT m) where type Ref (ListT m) = Ref m - newRef r = lift $ newRef r - readRef r = lift $ readRef r - writeRef r x = lift $ writeRef r x - modifyRef r f = lift $ modifyRef r f + newRef r = lift $ newRef r + readRef r = lift $ readRef r + writeRef r x = lift $ writeRef r x + modifyRef r f = lift $ modifyRef r f + modifyRef' r f = lift $ modifyRef' r f instance MonadRef m => MonadRef (MaybeT m) where type Ref (MaybeT m) = Ref m - newRef r = lift $ newRef r - readRef r = lift $ readRef r - writeRef r x = lift $ writeRef r x - modifyRef r f = lift $ modifyRef r f + newRef r = lift $ newRef r + readRef r = lift $ readRef r + writeRef r x = lift $ writeRef r x + modifyRef r f = lift $ modifyRef r f + modifyRef' r f = lift $ modifyRef' r f instance MonadRef m => MonadRef (ReaderT r m) where type Ref (ReaderT r m) = Ref m - newRef r = lift $ newRef r - readRef r = lift $ readRef r - writeRef r x = lift $ writeRef r x - modifyRef r f = lift $ modifyRef r f + newRef r = lift $ newRef r + readRef r = lift $ readRef r + writeRef r x = lift $ writeRef r x + modifyRef r f = lift $ modifyRef r f + modifyRef' r f = lift $ modifyRef' r f instance MonadRef m => MonadRef (Lazy.StateT s m) where type Ref (Lazy.StateT s m) = Ref m - newRef r = lift $ newRef r - readRef r = lift $ readRef r - writeRef r x = lift $ writeRef r x - modifyRef r f = lift $ modifyRef r f + newRef r = lift $ newRef r + readRef r = lift $ readRef r + writeRef r x = lift $ writeRef r x + modifyRef r f = lift $ modifyRef r f + modifyRef' r f = lift $ modifyRef' r f instance MonadRef m => MonadRef (Strict.StateT s m) where type Ref (Strict.StateT s m) = Ref m - newRef r = lift $ newRef r - readRef r = lift $ readRef r - writeRef r x = lift $ writeRef r x - modifyRef r f = lift $ modifyRef r f + newRef r = lift $ newRef r + readRef r = lift $ readRef r + writeRef r x = lift $ writeRef r x + modifyRef r f = lift $ modifyRef r f + modifyRef' r f = lift $ modifyRef' r f instance (Monoid w, MonadRef m) => MonadRef (Lazy.WriterT w m) where type Ref (Lazy.WriterT w m) = Ref m - newRef r = lift $ newRef r - readRef r = lift $ readRef r - writeRef r x = lift $ writeRef r x - modifyRef r f = lift $ modifyRef r f + newRef r = lift $ newRef r + readRef r = lift $ readRef r + writeRef r x = lift $ writeRef r x + modifyRef r f = lift $ modifyRef r f + modifyRef' r f = lift $ modifyRef' r f instance (Monoid w, MonadRef m) => MonadRef (Strict.WriterT w m) where type Ref (Strict.WriterT w m) = Ref m - newRef r = lift $ newRef r - readRef r = lift $ readRef r - writeRef r x = lift $ writeRef r x - modifyRef r f = lift $ modifyRef r f + newRef r = lift $ newRef r + readRef r = lift $ readRef r + writeRef r x = lift $ writeRef r x + modifyRef r f = lift $ modifyRef r f + modifyRef' r f = lift $ modifyRef' r f instance MonadAtomicRef IO where atomicModifyRef = atomicModifyIORef +#if MIN_VERSION_base(4,6,0) + atomicModifyRef' = atomicModifyIORef' +#endif /* MIN_VERSION_base(4,6,0) */ instance MonadAtomicRef STM where atomicModifyRef r f = do x <- readRef r @@ -179,31 +232,41 @@ return y instance MonadAtomicRef m => MonadAtomicRef (ContT r m) where - atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef' r f = lift $ atomicModifyRef' r f instance (Error e, MonadAtomicRef m) => MonadAtomicRef (ErrorT e m) where - atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef' r f = lift $ atomicModifyRef' r f instance MonadAtomicRef m => MonadAtomicRef (IdentityT m) where - atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef' r f = lift $ atomicModifyRef' r f instance MonadAtomicRef m => MonadAtomicRef (ListT m) where - atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef' r f = lift $ atomicModifyRef' r f instance MonadAtomicRef m => MonadAtomicRef (MaybeT m) where - atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef' r f = lift $ atomicModifyRef' r f instance MonadAtomicRef m => MonadAtomicRef (ReaderT r m) where - atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef' r f = lift $ atomicModifyRef' r f instance MonadAtomicRef m => MonadAtomicRef (Lazy.StateT s m) where - atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef' r f = lift $ atomicModifyRef' r f instance MonadAtomicRef m => MonadAtomicRef (Strict.StateT s m) where - atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef' r f = lift $ atomicModifyRef' r f instance (Monoid w, MonadAtomicRef m) => MonadAtomicRef (Lazy.WriterT w m) where - atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef' r f = lift $ atomicModifyRef' r f instance (Monoid w, MonadAtomicRef m) => MonadAtomicRef (Strict.WriterT w m) where - atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef r f = lift $ atomicModifyRef r f + atomicModifyRef' r f = lift $ atomicModifyRef' r f diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,3 +1,2 @@ import Distribution.Simple - main = defaultMain diff --git a/ref-tf.cabal b/ref-tf.cabal --- a/ref-tf.cabal +++ b/ref-tf.cabal @@ -1,14 +1,14 @@ name: ref-tf -version: 0.3.0.2 +version: 0.3.0.3 cabal-version: >= 1.6 license: BSD3 license-file: LICENSE copyright: (c) 2006-2011 Harvard University - (c) 2011-2012 Geoffrey Mainland -author: Geoffrey Mainland + (c) 2011-2014 Geoffrey Mainland +author: Geoffrey Mainland maintainer: mainland@eecs.harvard.edu stability: alpha -homepage: http://www.eecs.harvard.edu/~mainland/ +homepage: http://www.cs.drexel.edu/~mainland/ category: Control synopsis: A type class for monads with references using type families. description: Contains a 'MonadRef' type class that abstracts over the @@ -24,7 +24,7 @@ build-depends: base >= 4 && < 5, stm >= 2.1 && < 2.5, - transformers >= 0.2 && < 0.4 + transformers >= 0.2 && < 0.5 source-repository head type: git