STMonadTrans-0.4.3/0000755000000000000000000000000013047066030012220 5ustar0000000000000000STMonadTrans-0.4.3/changelog.md0000644000000000000000000000074113047066030014473 0ustar00000000000000000.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.3/STMonadTrans.cabal0000644000000000000000000000260413047066030015523 0ustar0000000000000000name: STMonadTrans version: 0.4.3 cabal-version: >= 1.8 license: BSD3 license-file: LICENSE author: Josef Svenningsson maintainer: josef.svenningsson@gmail.com 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. extra-source-files: changelog.md source-repository head type: git location: https://github.com/josefs/STMonadTrans flag splitBase description: Choose the new smaller, split-up base package. library if flag(splitBase) build-depends: base >= 3, base < 5, mtl, array else build-depends: base < 3 exposed-modules: Control.Monad.ST.Trans, Control.Monad.ST.Trans.Internal extensions: CPP, MagicHash, UnboxedTuples, Rank2Types, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances Test-Suite foo type: detailed-0.9 hs-source-dirs: test test-module: Test build-depends: STMonadTrans, base, mtl, array, Cabal STMonadTrans-0.4.3/LICENSE0000644000000000000000000000666213047066030013237 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.3/Setup.hs0000644000000000000000000000012713047066030013654 0ustar0000000000000000module Main (main) where import Distribution.Simple main :: IO () main = defaultMain STMonadTrans-0.4.3/test/0000755000000000000000000000000013047066030013177 5ustar0000000000000000STMonadTrans-0.4.3/test/Test.hs0000644000000000000000000000152013047066030014450 0ustar0000000000000000module Test where import Control.Monad import Control.Monad.Trans import Control.Monad.ST.Trans import Data.Array import Distribution.TestSuite foo :: Int -> Maybe (Array Int Int) foo i = runSTArray $ do arr <- newSTArray (1, 3) 0 lift $ guard $ i > 0 writeSTArray arr 2 i return arr ups :: (Maybe (Array Int Int, Array Int Int)) ups = (,) <$> foo 5 <*> foo 6 main :: IO () main = print ups tests :: IO [Test] tests = return [Test bar] where bar = TestInstance { run = return $ Finished runUps , name = "array creation" , tags = [] , options = [] , setOption = \_ _ -> Right bar } runUps = case ups of Just (a1,a2) | elems a1 /= elems a2 -> Pass | otherwise -> Fail "Only created one array." _ -> Error "Got Nothing! Shouldn't happen." STMonadTrans-0.4.3/Control/0000755000000000000000000000000013047066030013640 5ustar0000000000000000STMonadTrans-0.4.3/Control/Monad/0000755000000000000000000000000013047066030014676 5ustar0000000000000000STMonadTrans-0.4.3/Control/Monad/ST/0000755000000000000000000000000013047066030015224 5ustar0000000000000000STMonadTrans-0.4.3/Control/Monad/ST/Trans.hs0000644000000000000000000001463513047066030016660 0ustar0000000000000000{-# LANGUAGE CPP, MagicHash, UnboxedTuples, Rank2Types, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, RecursiveDo #-} {- | Module : Control.Monad.ST.Trans Copyright : Josef Svenningsson 2008-2017 (c) The University of Glasgow, 1994-2000 License : BSD Maintainer : josef.svenningsson@gmail.com Stability : experimental 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 import GHC.Arr (Ix(..), safeRangeSize, safeIndex, Array(..), arrEleBottom) import qualified GHC.Arr as STArray import Data.STRef (STRef) import qualified Data.STRef as STRef import Data.Array.ST hiding (runSTArray) import qualified Data.Array.ST as STArray import Control.Applicative import Control.Monad.ST.Trans.Internal import Data.IORef import Unsafe.Coerce import System.IO.Unsafe #if __GLASGOW_HASKELL__ < 708 isTrue# :: Bool -> Bool isTrue# x = x #endif {-# INLINE newSTRef #-} -- | Create a new reference newSTRef :: (Applicative m, Monad m) => a -> STT s m (STRef s a) newSTRef init = liftST (STRef.newSTRef init) {-# INLINE readSTRef #-} -- | Reads the value of a reference readSTRef :: (Applicative m, Monad 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, Monad 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 GHC's parser 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, Monad m) => (i,i) -> e -> STT s m (STArray s i e) newSTArray bounds init = liftST (newArray bounds init) {-# 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, Monad m) => STArray s i e -> i -> STT s m e readSTArray arr i = liftST (readArray arr i) {-# INLINE unsafeReadSTArray #-} unsafeReadSTArray :: (Ix i, Applicative m, Monad 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, Monad m) => STArray s i e -> i -> e -> STT s m () writeSTArray arr i e = liftST (writeArray arr i e) {-# INLINE unsafeWriteSTArray #-} unsafeWriteSTArray :: (Ix i, Applicative m, Monad 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 :: (Ix i, Applicative m, Monad m) => STArray s i e -> STT s m (Array i e) freezeSTArray arr = liftST (STArray.freezeSTArray arr) {-# INLINE unsafeFreezeSTArray #-} unsafeFreezeSTArray :: (Ix i, Applicative m, Monad 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 :: (Ix i, Applicative m, Monad m) => Array i e -> STT s m (STArray s i e) thawSTArray arr = liftST (STArray.thawSTArray arr) {-# INLINE unsafeThawSTArray #-} unsafeThawSTArray :: (Ix i, Applicative m, Monad 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 :: (Ix i, Applicative m, 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) => 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.3/Control/Monad/ST/Trans/0000755000000000000000000000000013047066030016313 5ustar0000000000000000STMonadTrans-0.4.3/Control/Monad/ST/Trans/Internal.hs0000644000000000000000000003116213047066030020426 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 Stability : experimental Portability : non-portable (GHC Extensions) This module provides the implementation of the 'STT' type for those occasions where it's 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 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 import Control.Applicative 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 => Monad (STT s m) where return a = STT $ \st -> return (STTRet st a) STT m >>= k = STT $ \st -> do ret <- m st case ret of STTRet new_st a -> unSTT (k a) new_st fail msg = lift (fail msg) 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) => 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)) -- Instances of other monad classes instance MonadError e 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 => MonadReader r (STT s m) where ask = lift ask local f (STT m) = STT $ \st -> local f (m st) instance MonadState s m => MonadState s (STT s' m) where get = lift get put s = lift (put s) instance MonadWriter w 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 bounds e = liftST (newArray bounds 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 bounds e = liftST (newArray bounds 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) Char (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bounds e = liftST (newArray bounds 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) Int (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bounds e = liftST (newArray bounds 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) Word (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bounds e = liftST (newArray bounds 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) (Ptr a) (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bounds e = liftST (newArray bounds 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) (FunPtr a) (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bounds e = liftST (newArray bounds 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) Float (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bounds e = liftST (newArray bounds 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) Double (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bounds e = liftST (newArray bounds 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) (StablePtr a) (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bounds e = liftST (newArray bounds 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) Int8 (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bounds e = liftST (newArray bounds 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) Int16 (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bounds e = liftST (newArray bounds 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) Int32 (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bounds e = liftST (newArray bounds 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) Int64 (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bounds e = liftST (newArray bounds 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) Word8 (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bounds e = liftST (newArray bounds 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) Word16 (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bounds e = liftST (newArray bounds 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) Word32 (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bounds e = liftST (newArray bounds 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) Word64 (STT s m) where {-# INLINE getBounds #-} getBounds arr = liftST (getBounds arr) {-# INLINE getNumElements #-} getNumElements arr = liftST (getNumElements arr) {-# INLINE newArray #-} newArray bounds e = liftST (newArray bounds e) {-# INLINE unsafeRead #-} unsafeRead arr i = liftST (unsafeRead arr i) {-# INLINE unsafeWrite #-} unsafeWrite arr i e = liftST (unsafeWrite arr i e)