STMonadTrans-0.4.8/0000755000000000000000000000000007346545000012231 5ustar0000000000000000STMonadTrans-0.4.8/Control/Monad/ST/0000755000000000000000000000000007346545000015235 5ustar0000000000000000STMonadTrans-0.4.8/Control/Monad/ST/Trans.hs0000644000000000000000000001511707346545000016665 0ustar0000000000000000{-# LANGUAGE CPP, MagicHash, Rank2Types #-} {- | Module : Control.Monad.ST.Trans Copyright : Josef Svenningsson 2008-2017 (c) The University of Glasgow, 1994-2000 License : BSD Maintainer : josef.svenningsson@gmail.com, Andreas Abel Stability : stable Portability : non-portable (GHC Extensions) This library provides a monad transformer version of the ST monad. Warning! This monad transformer should not be used with monads that can contain multiple answers, like the list monad. The reason is that the state token will be duplicated across the different answers and this causes Bad Things to happen (such as loss of referential transparency). Safe monads include the monads @'State'@, @'Reader'@, @'Writer'@, @'Maybe'@ and combinations of their corresponding monad transformers. -} module Control.Monad.ST.Trans( -- * The ST Monad Transformer STT, runST, runSTT, -- * Mutable references STRef, newSTRef, readSTRef, writeSTRef, -- * Mutable arrays STArray, newSTArray, readSTArray, writeSTArray, boundsSTArray, numElementsSTArray, freezeSTArray, thawSTArray, runSTArray, -- * Unsafe Operations unsafeReadSTArray, unsafeWriteSTArray, unsafeFreezeSTArray, unsafeThawSTArray, unsafeIOToSTT, unsafeSTToIO, unsafeSTTToIO, unsafeSTRefToIORef, unsafeIORefToSTRef ) where import GHC.Base (realWorld#) import GHC.Arr (Ix, Array(..)) import qualified GHC.Arr as STArray #if __GLASGOW_HASKELL__ <= 708 import Control.Applicative (Applicative) #endif import Control.Monad.ST.Trans.Internal import Data.Array.ST (STArray, newArray, readArray, writeArray) import Data.IORef (IORef) import Data.STRef (STRef) import qualified Data.STRef as STRef import System.IO.Unsafe (unsafePerformIO) import Unsafe.Coerce (unsafeCoerce) {-# INLINE newSTRef #-} -- | Create a new reference newSTRef :: (Applicative m) => a -> STT s m (STRef s a) newSTRef i = liftST (STRef.newSTRef i) {-# INLINE readSTRef #-} -- | Reads the value of a reference readSTRef :: (Applicative m) => STRef s a -> STT s m a readSTRef ref = liftST (STRef.readSTRef ref) {-# INLINE writeSTRef #-} -- | Modifies the value of a reference writeSTRef :: (Applicative m) => STRef s a -> a -> STT s m () writeSTRef ref a = liftST (STRef.writeSTRef ref a) {-# DEPRECATED runST "Use runSTT instead" #-} {-# NOINLINE runST #-} -- | Executes a computation in the 'STT' monad transformer runST :: Monad m => (forall s. STT s m a) -> m a runST m = let (STT f) = m -- the parenthesis is needed because of a bug in the parser of GHC in do (STTRet _st a) <- ( f realWorld# ) return a {-# NOINLINE runSTT #-} -- | Executes a computation in the 'STT' monad transformer runSTT :: Monad m => (forall s. STT s m a) -> m a runSTT m = let (STT f) = m in do (STTRet _st a) <- ( f realWorld# ) return a -- Mutable arrays. {-# INLINE newSTArray #-} -- | Creates a new mutable array newSTArray :: (Ix i, Applicative m) => (i,i) -> e -> STT s m (STArray s i e) newSTArray bnds i = liftST (newArray bnds i) {-# INLINE boundsSTArray #-} -- | Returns the lowest and highest indices of the array boundsSTArray :: STArray s i e -> (i,i) boundsSTArray = STArray.boundsSTArray {-# INLINE numElementsSTArray #-} -- | Returns the number of elements in the array numElementsSTArray :: STArray s i e -> Int numElementsSTArray = STArray.numElementsSTArray {-# INLINE readSTArray #-} -- | Retrieves an element from the array readSTArray :: (Ix i, Applicative m) => STArray s i e -> i -> STT s m e readSTArray arr i = liftST (readArray arr i) {-# INLINE unsafeReadSTArray #-} unsafeReadSTArray :: ( #if __GLASGOW_HASKELL__ <= 710 Ix i, #endif Applicative m) => STArray s i e -> Int -> STT s m e unsafeReadSTArray arr i = liftST (STArray.unsafeReadSTArray arr i) {-# INLINE writeSTArray #-} -- | Modifies an element in the array writeSTArray :: (Ix i, Applicative m) => STArray s i e -> i -> e -> STT s m () writeSTArray arr i e = liftST (writeArray arr i e) {-# INLINE unsafeWriteSTArray #-} unsafeWriteSTArray :: ( #if __GLASGOW_HASKELL__ <= 710 Ix i, #endif Applicative m) => STArray s i e -> Int -> e -> STT s m () unsafeWriteSTArray arr i e = liftST (STArray.unsafeWriteSTArray arr i e) {-# INLINE freezeSTArray #-} -- | Copy a mutable array and turn it into an immutable array freezeSTArray :: ( #if __GLASGOW_HASKELL__ <= 710 Ix i, #endif Applicative m) => STArray s i e -> STT s m (Array i e) freezeSTArray arr = liftST (STArray.freezeSTArray arr) {-# INLINE unsafeFreezeSTArray #-} unsafeFreezeSTArray :: ( #if __GLASGOW_HASKELL__ <= 710 Ix i, #endif Applicative m) => STArray s i e -> STT s m (Array i e) unsafeFreezeSTArray arr = liftST (STArray.unsafeFreezeSTArray arr) {-# INLINE thawSTArray #-} -- | Copy an immutable array and turn it into a mutable array thawSTArray :: ( #if __GLASGOW_HASKELL__ <= 710 Ix i, #endif Applicative m) => Array i e -> STT s m (STArray s i e) thawSTArray arr = liftST (STArray.thawSTArray arr) {-# INLINE unsafeThawSTArray #-} unsafeThawSTArray :: ( #if __GLASGOW_HASKELL__ <= 710 Ix i, #endif Applicative m) => Array i e -> STT s m (STArray s i e) unsafeThawSTArray arr = liftST (STArray.unsafeThawSTArray arr) {-# INLINE runSTArray #-} -- | A safe way to create and work with a mutable array before returning an -- immutable array for later perusal. This function avoids copying -- the array before returning it. runSTArray :: ( #if __GLASGOW_HASKELL__ <= 710 Ix i, #endif #if __GLASGOW_HASKELL__ <= 708 Applicative m, #endif Monad m) => (forall s . STT s m (STArray s i e)) -> m (Array i e) runSTArray st = runSTT (st >>= unsafeFreezeSTArray) {-# NOINLINE unsafeIOToSTT #-} unsafeIOToSTT :: (Monad m, Functor m) => IO a -> STT s m a unsafeIOToSTT m = return $! unsafePerformIO m {-# DEPRECATED unsafeSTToIO "Use unsafeSTTToIO instead" #-} unsafeSTToIO :: STT s IO a -> IO a unsafeSTToIO m = runSTT $ unsafeCoerce m unsafeSTTToIO :: STT s IO a -> IO a unsafeSTTToIO m = runSTT $ unsafeCoerce m -- This should work, as STRef and IORef should have identical internal representation unsafeSTRefToIORef :: STRef s a -> IORef a unsafeSTRefToIORef ref = unsafeCoerce ref unsafeIORefToSTRef :: IORef a -> STRef s a unsafeIORefToSTRef ref = unsafeCoerce ref STMonadTrans-0.4.8/Control/Monad/ST/Trans/0000755000000000000000000000000007346545000016324 5ustar0000000000000000STMonadTrans-0.4.8/Control/Monad/ST/Trans/Internal.hs0000644000000000000000000003757307346545000020453 0ustar0000000000000000{-# LANGUAGE MagicHash, UnboxedTuples, Rank2Types, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, RecursiveDo #-} {- | Module : Control.Monad.ST.Trans Copyright : Josef Svenningsson 2008-2010 (c) The University of Glasgow, 1994-2000 License : BSD Maintainer : josef.svenningsson@gmail.com, Andreas Abel Stability : stable Portability : non-portable (GHC Extensions) This module provides the implementation of the 'STT' type for those occasions where it is needed in order to implement new liftings through operations in other monads. Warning! This monad transformer should not be used with monads that can contain multiple answers, like the list monad. The reason is that the will be duplicated across the different answers and this cause Bad Things to happen (such as loss of referential transparency). Safe monads include the monads State, Reader, Writer, Maybe and combinations of their corresponding monad transformers. -} module Control.Monad.ST.Trans.Internal where import GHC.Base import GHC.ST hiding (liftST) import qualified Control.Monad.Fail as MF import Control.Monad.Fix import Control.Monad.Trans import Control.Monad.Error.Class import Control.Monad.Reader.Class import Control.Monad.State.Class import Control.Monad.Writer.Class #if __GLASGOW_HASKELL__ <= 708 import Control.Applicative #endif import Data.Array.ST import Data.Array.Base import GHC.Int (Int8, Int16, Int32, Int64) import GHC.Word (Word8, Word16, Word32, Word64) import GHC.Ptr (Ptr, FunPtr) import GHC.Stable (StablePtr) -- | 'STT' is the monad transformer providing polymorphic updateable references newtype STT s m a = STT (State# s -> m (STTRet s a)) unSTT :: STT s m a -> (State# s -> m (STTRet s a)) unSTT (STT f) = f -- | 'STTRet' is needed to encapsulate the unboxed state token that GHC passes -- around. This type is essentially a pair, but an ordinary pair is not -- not allowed to contain unboxed types. data STTRet s a = STTRet (State# s) a -- | Lifting the `ST` monad into `STT`. The library uses this function -- extensively to be able to reuse functions from `ST`. liftST :: Applicative m => ST s a -> STT s m a liftST (ST f) = STT (\s -> let !(# s', a #) = f s in pure (STTRet s' a)) {-# INLINE liftST #-} -- All instances have to go in this module because otherwise they -- would be orphan instances. instance (Monad m, Functor m) => Monad (STT s m) where return = pure STT m >>= k = STT $ \st -> do ret <- m st case ret of STTRet new_st a -> unSTT (k a) new_st instance (MF.MonadFail m, Functor m) => MF.MonadFail (STT s m) where fail msg = lift (fail msg) instance (MonadIO m, Functor m) => MonadIO (STT s m) where liftIO = lift . liftIO instance MonadTrans (STT s) where lift m = STT $ \st -> do a <- m return (STTRet st a) liftSTT :: STT s m a -> State# s -> m (STTRet s a) liftSTT (STT m) s = m s instance (MonadFix m, Functor m) => MonadFix (STT s m) where mfix k = STT $ \ s -> mdo ans@(STTRet _ r) <- liftSTT (k r) s return ans instance Functor (STTRet s) where fmap f (STTRet s a) = STTRet s (f a) instance Functor m => Functor (STT s m) where fmap f (STT g) = STT $ \s# -> (fmap . fmap) f (g s#) instance (Monad m, Functor m) => Applicative (STT s m) where pure a = STT $ \s# -> return (STTRet s# a) (STT m) <*> (STT n) = STT $ \s1 -> do (STTRet s2 f) <- m s1 (STTRet s3 x) <- n s2 return (STTRet s3 (f x)) instance (Monad m, Alternative m) => Alternative (STT s m) where empty = STT $ \_ -> empty STT m <|> STT n = STT $ \s# -> m s# <|> n s# -- Instances of other monad classes instance (MonadError e m, Functor m) => MonadError e (STT s m) where throwError e = lift (throwError e) catchError (STT m) f = STT $ \st -> catchError (m st) (\e -> unSTT (f e) st) instance (MonadReader r m, Functor m) => MonadReader r (STT s m) where ask = lift ask local f (STT m) = STT $ \st -> local f (m st) instance (MonadState s m, Functor m) => MonadState s (STT s1 m) where get = lift get put s = lift (put s) instance (MonadWriter w m, Functor m) => MonadWriter w (STT s m) where tell w = lift (tell w) listen (STT m)= STT $ \st1 -> do (STTRet st2 a, w) <- listen (m st1) return (STTRet st2 (a,w)) pass (STT m) = STT $ \st1 -> pass (do (STTRet st2 (a,f)) <- m st1 return (STTRet st2 a, f)) -- MArray instances instance (Applicative m, Monad m) => MArray (STArray s) e (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e) instance (Applicative m, Monad m) => MArray (STUArray s) Bool (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) {-# INLINE newArray_ #-} newArray_ arrBounds = liftST (newArray_ arrBounds) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e) instance (Applicative m, Monad m) => MArray (STUArray s) Char (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) {-# INLINE newArray_ #-} newArray_ arrBounds = liftST (newArray_ arrBounds) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e) instance (Applicative m, Monad m) => MArray (STUArray s) Int (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) {-# INLINE newArray_ #-} newArray_ arrBounds = liftST (newArray_ arrBounds) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e) instance (Applicative m, Monad m) => MArray (STUArray s) Word (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) {-# INLINE newArray_ #-} newArray_ arrBounds = liftST (newArray_ arrBounds) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e) instance (Applicative m, Monad m) => MArray (STUArray s) (Ptr a) (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) {-# INLINE newArray_ #-} newArray_ arrBounds = liftST (newArray_ arrBounds) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e) instance (Applicative m, Monad m) => MArray (STUArray s) (FunPtr a) (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) {-# INLINE newArray_ #-} newArray_ arrBounds = liftST (newArray_ arrBounds) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e) instance (Applicative m, Monad m) => MArray (STUArray s) Float (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) {-# INLINE newArray_ #-} newArray_ arrBounds = liftST (newArray_ arrBounds) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e) instance (Applicative m, Monad m) => MArray (STUArray s) Double (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) {-# INLINE newArray_ #-} newArray_ arrBounds = liftST (newArray_ arrBounds) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e) instance (Applicative m, Monad m) => MArray (STUArray s) (StablePtr a) (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) {-# INLINE newArray_ #-} newArray_ arrBounds = liftST (newArray_ arrBounds) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e) instance (Applicative m, Monad m) => MArray (STUArray s) Int8 (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) {-# INLINE newArray_ #-} newArray_ arrBounds = liftST (newArray_ arrBounds) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e) instance (Applicative m, Monad m) => MArray (STUArray s) Int16 (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) {-# INLINE newArray_ #-} newArray_ arrBounds = liftST (newArray_ arrBounds) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e) instance (Applicative m, Monad m) => MArray (STUArray s) Int32 (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) {-# INLINE newArray_ #-} newArray_ arrBounds = liftST (newArray_ arrBounds) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e) instance (Applicative m, Monad m) => MArray (STUArray s) Int64 (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) {-# INLINE newArray_ #-} newArray_ arrBounds = liftST (newArray_ arrBounds) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e) instance (Applicative m, Monad m) => MArray (STUArray s) Word8 (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) {-# INLINE newArray_ #-} newArray_ arrBounds = liftST (newArray_ arrBounds) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e) instance (Applicative m, Monad m) => MArray (STUArray s) Word16 (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) {-# INLINE newArray_ #-} newArray_ arrBounds = liftST (newArray_ arrBounds) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e) instance (Applicative m, Monad m) => MArray (STUArray s) Word32 (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) {-# INLINE newArray_ #-} newArray_ arrBounds = liftST (newArray_ arrBounds) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e) instance (Applicative m, Monad m) => MArray (STUArray s) Word64 (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bnds e = liftST (newArray bnds e) {-# INLINE newArray_ #-} newArray_ arrBounds = liftST (newArray_ arrBounds) {-# INLINE unsafeNewArray_ #-} unsafeNewArray_ bnds = liftST (unsafeNewArray_ bnds) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e) STMonadTrans-0.4.8/LICENSE0000644000000000000000000000666207346545000013250 0ustar0000000000000000This library contains code from several sources. The full text of these licenses is reproduced below. All of the licenses are BSD-style or compatible. ----------------------------------------------------------------------------- Copyright Josef Svenningsson, 2008-2010 Copyright The University of Glasgow, 1994-2000 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Josef Svenningsson nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ----------------------------------------------------------------------------- The Glasgow Haskell Compiler License Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. STMonadTrans-0.4.8/README.md0000644000000000000000000000212507346545000013510 0ustar0000000000000000# STMonadTrans [![Hackage](https://img.shields.io/hackage/v/STMonadTrans.svg?label=Hackage&color=informational)](https://hackage.haskell.org/package/STMonadTrans) [![STMonadTrans on Stackage Nightly](https://stackage.org/package/STMonadTrans/badge/nightly)](https://stackage.org/nightly/package/STMonadTrans) [![Stackage](https://www.stackage.org/package/STMonadTrans/badge/lts?label=Stackage)](https://www.stackage.org/package/STMonadTrans) [![Build Status](https://github.com/josefs/STMonadTrans/workflows/Haskell-CI/badge.svg)](https://github.com/josefs/STMonadTrans/actions) A monad transformer version of the [ST monad](https://hackage.haskell.org/package/base/docs/Control-Monad-ST.html). Warning! This monad transformer should not be used with monads that can contain multiple answers, like the list monad. The reason is that the state token will be duplicated across the different answers and this causes Bad Things to happen (such as loss of referential transparency). Safe monads include the monads `State`, `Reader`, `Writer`, `Maybe` and combinations of their corresponding monad transformers. STMonadTrans-0.4.8/STMonadTrans.cabal0000644000000000000000000000402607346545000015534 0ustar0000000000000000cabal-version: 1.18 name: STMonadTrans version: 0.4.8 license: BSD3 license-file: LICENSE author: Josef Svenningsson maintainer: Andreas Abel, josef.svenningsson@gmail.com homepage: https://github.com/josefs/STMonadTrans bug-reports: https://github.com/josefs/STMonadTrans/issues category: Monads build-type: Simple synopsis: A monad transformer version of the ST monad description: A monad transformer version of the ST monad. . Warning! This monad transformer should not be used with monads that can contain multiple answers, like the list monad. The reason is that the state token will be duplicated across the different answers and this causes Bad Things to happen (such as loss of referential transparency). Safe monads include the monads State, Reader, Writer, Maybe and combinations of their corresponding monad transformers. Tested-With: GHC == 9.8.1 GHC == 9.6.3 GHC == 9.4.8 GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 GHC == 8.6.5 GHC == 8.4.4 GHC == 8.2.2 GHC == 8.0.2 extra-doc-files: README.md changelog.md source-repository head type: git location: https://github.com/josefs/STMonadTrans library default-language: Haskell2010 build-depends: base >= 4.9 && < 5 , transformers >= 0.2.0.0 && < 0.7 , mtl >= 1.1 , array exposed-modules: Control.Monad.ST.Trans Control.Monad.ST.Trans.Internal default-extensions: CPP BangPatterns MagicHash UnboxedTuples Rank2Types FlexibleInstances MultiParamTypeClasses UndecidableInstances ghc-options: -Wall -fwarn-tabs -Wcompat test-suite test default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Main.hs build-depends: STMonadTrans , array , base , transformers , tasty >= 0.11.0.4 && < 1.6 , tasty-quickcheck >= 0.8.4 && < 0.11 , tasty-hunit >= 0.9.2 && < 0.11 STMonadTrans-0.4.8/Setup.hs0000644000000000000000000000012707346545000013665 0ustar0000000000000000module Main (main) where import Distribution.Simple main :: IO () main = defaultMain STMonadTrans-0.4.8/changelog.md0000644000000000000000000000273707346545000014513 0ustar00000000000000000.4.8 -- 2023-01-04 * Added `Alternative` instance for `STT`, by William Rusnack (PR [#33](https://github.com/josefs/STMonadTrans/pull/33)). * Drop support for GHC 7. * Tested with GHC 8.0.2 - 9.8.1. 0.4.7 -- 2023-05-18 * Added `MonadIO` for `SST` (issue [#29](https://github.com/josefs/STMonadTrans/issues/29)). * Make `transformers` dependency explicit. * Bump `cabal-version` of `STMonadTrans.cabal` to 1.18. * Tested with GHC 7.6.3 - 9.6.1. 0.4.6 -- 2021-08-21 * Warning-free for all supported GHC versions (7.6 -- 9.2). * Drop `splitBase` cabal flag (`base >= 4` is already assumed). * Include `README.md` in distributed tarball. * Added maintainer Andreas Abel. 0.4.5 * Don't use default class methods in any `MArray (STUArray s)` instance. Thanks to Henri Jones. * Allow `tasty` up to and including 1.4. 0.4.4 * Fix compilation for GHC 8.8.1. Thanks to Andrés Sicard-Ramírez. * Fix some tests and their dependencies. Thanks to Kirill Zaborsky. 0.4.3 * Fix compilation for GHC 7.6.3. Thanks to Andrés Sicard-Ramírez. * Export unsafe array operations. 0.4.2 * Deprecate `runST` and `unsafeSTToIO` in favor of `runSTT` and `unsafeSTTToIO`. * Added `INLINE` pragmas. 0.4.1 * Add `Applicative` constraints to be compatible with GHC 7.8.4. * Add changelog. 0.4 * New library structure, based on `liftST`. It reuses more code and types from the standard `ST` monad. Thanks to @wyager for `liftST`. * Instances for `MArray`. STMonadTrans-0.4.8/test/0000755000000000000000000000000007346545000013210 5ustar0000000000000000STMonadTrans-0.4.8/test/Main.hs0000644000000000000000000001031207346545000014425 0ustar0000000000000000import Test.Tasty import Test.Tasty.QuickCheck import Test.Tasty.HUnit import GHC.STRef (STRef) import GHC.Arr (Array, listArray, (//)) import Control.Applicative ((<|>), empty) import Control.Monad.ST.Trans import Control.Monad.IO.Class import Control.Monad.Trans.Class import Control.Monad (guard) import Data.Array.ST (STUArray, freeze, newArray, newArray_, readArray, thaw, writeArray) props :: TestTree props = testGroup "Properties" [ testProperty "runSTT respects return" $ \x -> runSTT (return x) == Just (x :: Int), testProperty "STT respects MonadTrans" $ \m -> runSTT (lift m) == (m :: Maybe Int), testProperty "STT respects Alternative Left" $ \m -> runSTT (lift m <|> empty) == (m :: Maybe Int), testProperty "STT respects Alternative Right" $ \m -> runSTT (empty <|> lift m) == (m :: Maybe Int), testProperty "newSTRef . readSTRef == id" $ \x -> runSTT ((newSTRef x :: STT s Maybe (STRef s Int)) >>= readSTRef) == Just x, testProperty "writeSTRef overwrite" $ \x y -> runSTT (do ref <- newSTRef x writeSTRef ref y readSTRef ref) == Just (y :: Int), testGroup "STArray" [ testProperty "newSTArray makes correct Arrays" $ \t e -> 0 <= t ==> runSTT (newSTArray (0,t) e >>= freezeSTArray) == Just (listArray (0,t) (repeat e) :: Array Int Int), testProperty "writeSTArray overwrite" $ \t e y -> 0 <= t ==> runSTT (do arr <- newSTArray (0,t) e mapM_ (\i -> writeSTArray arr i y) [0..t] freezeSTArray arr) == Just (listArray (0,t) (repeat y) :: Array Int Int), testProperty "thawSTArray . freezeSTArray == id" $ \l -> let a = listArray (0,length l - 1) l in runSTT (thawSTArray a >>= freezeSTArray) == Just (a :: Array Int Int), testProperty "writeSTArray . thawSTArray == update a" $ \l i e -> let a = listArray (0, length l - 1) l in 0 <= i && i < length l ==> runSTT (do stArr <- thawSTArray a writeSTArray stArr i e freezeSTArray stArr) == Just (a // [(i,e)] :: Array Int Int) ], testGroup "STUArray" [ testProperty "newArray makes correct Arrays" $ \t e -> 0 <= t ==> runSTT (do stuArr <- newArray (0,t) e :: STT s Maybe (STUArray s Int Int) freeze stuArr) == Just (listArray (0,t) (repeat e) :: Array Int Int), testProperty "writeArray overwrite" $ \t e y -> 0 <= t ==> runSTT (do stuArr <- newArray (0,t) e :: STT s Maybe (STUArray s Int Int) mapM_ (\i -> writeArray stuArr i y) [0..t] freeze stuArr) == Just (listArray (0,t) (repeat y) :: Array Int Int), testProperty "thaw . freeze == id" $ \l -> let a = listArray (0,length l - 1) l in runSTT (do stuArr <- thaw a :: STT s Maybe (STUArray s Int Int) freeze stuArr) == Just (a :: Array Int Int), testProperty "writeArray . thawArray == update a" $ \l i e -> let a = listArray (0, length l - 1) l in 0 <= i && i < length l ==> runSTT (do stuArr <- thaw a :: STT s Maybe (STUArray s Int Int) writeArray stuArr i e freeze stuArr) == Just (a // [(i,e)] :: Array Int Int), testProperty "writeArray overwrite uninitialised array" $ \t e -> 0 <= t ==> runSTT (do stuArr <- newArray_ (0,t) :: STT s Maybe (STUArray s Int Int) mapM_ (\i -> writeArray stuArr i e) [0..t] freeze stuArr) == Just (listArray (0,t) (repeat e) :: Array Int Int) ] ] unitTests :: TestTree unitTests = testGroup "Unit Tests" [ testCase "ST Ref" $ runSTT (do ref <- newSTRef 0 curNum <- readSTRef ref writeSTRef ref (curNum + 6) nextNum <- readSTRef ref lift (guard (nextNum == 6)) return nextNum) @?= Just 6 ] main :: IO () main = defaultMain (testGroup "All Tests" [props,unitTests]) -- Test for presence of MonadIO instance haveMonadIO :: IO () haveMonadIO = runSTT $ liftIO $ putStrLn "We have the MonadIO instance!"