{-# LANGUAGE CPP, MagicHash, UnboxedTuples, Rank2Types, FlexibleInstances,
MultiParamTypeClasses, UndecidableInstances, RecursiveDo #-}
module Control.Monad.ST.Trans(
STT,
runST,
runSTT,
STRef,
newSTRef,
readSTRef,
writeSTRef,
STArray,
newSTArray,
readSTArray,
writeSTArray,
boundsSTArray,
numElementsSTArray,
freezeSTArray,
thawSTArray,
runSTArray,
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 #-}
newSTRef :: (Applicative m, Monad m) => a -> STT s m (STRef s a)
newSTRef init = liftST (STRef.newSTRef init)
{-# INLINE readSTRef #-}
readSTRef :: (Applicative m, Monad m) => STRef s a -> STT s m a
readSTRef ref = liftST (STRef.readSTRef ref)
{-# INLINE writeSTRef #-}
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 #-}
runST :: Monad m => (forall s. STT s m a) -> m a
runST m = let (STT f) = m
in do (STTRet _st a) <- ( f realWorld# )
return a
{-# NOINLINE runSTT #-}
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
{-# INLINE newSTArray #-}
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 #-}
boundsSTArray :: STArray s i e -> (i,i)
boundsSTArray = STArray.boundsSTArray
{-# INLINE numElementsSTArray #-}
numElementsSTArray :: STArray s i e -> Int
numElementsSTArray = STArray.numElementsSTArray
{-# INLINE readSTArray #-}
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 #-}
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 #-}
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 #-}
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 #-}
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
unsafeSTRefToIORef :: STRef s a -> IORef a
unsafeSTRefToIORef ref = unsafeCoerce ref
unsafeIORefToSTRef :: IORef a -> STRef s a
unsafeIORefToSTRef ref = unsafeCoerce ref