{-# LANGUAGE CPP, MagicHash, Rank2Types #-}
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(..), Array(..))
import qualified GHC.Arr as STArray
import Data.STRef (STRef)
import qualified Data.STRef as STRef
import Data.Array.ST hiding (runSTArray)
#if __GLASGOW_HASKELL__ <= 708
import Control.Applicative
#endif
import Control.Monad.ST.Trans.Internal
import Data.IORef
import Unsafe.Coerce
import System.IO.Unsafe
{-# INLINE newSTRef #-}
newSTRef :: (Applicative m) => a -> STT s m (STRef s a)
newSTRef :: a -> STT s m (STRef s a)
newSTRef i :: a
i = ST s (STRef s a) -> STT s m (STRef s a)
forall (m :: * -> *) s a. Applicative m => ST s a -> STT s m a
liftST (a -> ST s (STRef s a)
forall a s. a -> ST s (STRef s a)
STRef.newSTRef a
i)
{-# INLINE readSTRef #-}
readSTRef :: (Applicative m) => STRef s a -> STT s m a
readSTRef :: STRef s a -> STT s m a
readSTRef ref :: STRef s a
ref = ST s a -> STT s m a
forall (m :: * -> *) s a. Applicative m => ST s a -> STT s m a
liftST (STRef s a -> ST s a
forall s a. STRef s a -> ST s a
STRef.readSTRef STRef s a
ref)
{-# INLINE writeSTRef #-}
writeSTRef :: (Applicative m) => STRef s a -> a -> STT s m ()
writeSTRef :: STRef s a -> a -> STT s m ()
writeSTRef ref :: STRef s a
ref a :: a
a = ST s () -> STT s m ()
forall (m :: * -> *) s a. Applicative m => ST s a -> STT s m a
liftST (STRef s a -> a -> ST s ()
forall s a. STRef s a -> a -> ST s ()
STRef.writeSTRef STRef s a
ref a
a)
{-# DEPRECATED runST "Use runSTT instead" #-}
{-# NOINLINE runST #-}
runST :: Monad m => (forall s. STT s m a) -> m a
runST :: (forall s. STT s m a) -> m a
runST m :: forall s. STT s m a
m = let (STT f :: State# s -> m (STTRet s a)
f) = STT s m a
forall s. STT s m a
m
in do (STTRet _st :: State# RealWorld
_st a :: a
a) <- ( State# RealWorld -> m (STTRet RealWorld a)
forall s. State# s -> m (STTRet s a)
f State# RealWorld
realWorld# )
a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
{-# NOINLINE runSTT #-}
runSTT :: Monad m => (forall s. STT s m a) -> m a
runSTT :: (forall s. STT s m a) -> m a
runSTT m :: forall s. STT s m a
m = let (STT f :: State# s -> m (STTRet s a)
f) = STT s m a
forall s. STT s m a
m
in do (STTRet _st :: State# RealWorld
_st a :: a
a) <- ( State# RealWorld -> m (STTRet RealWorld a)
forall s. State# s -> m (STTRet s a)
f State# RealWorld
realWorld# )
a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
{-# INLINE newSTArray #-}
newSTArray :: (Ix i, Applicative m) =>
(i,i) -> e -> STT s m (STArray s i e)
newSTArray :: (i, i) -> e -> STT s m (STArray s i e)
newSTArray bnds :: (i, i)
bnds i :: e
i = ST s (STArray s i e) -> STT s m (STArray s i e)
forall (m :: * -> *) s a. Applicative m => ST s a -> STT s m a
liftST ((i, i) -> e -> ST s (STArray s i e)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (i, i)
bnds e
i)
{-# INLINE boundsSTArray #-}
boundsSTArray :: STArray s i e -> (i,i)
boundsSTArray :: STArray s i e -> (i, i)
boundsSTArray = STArray s i e -> (i, i)
forall s i e. STArray s i e -> (i, i)
STArray.boundsSTArray
{-# INLINE numElementsSTArray #-}
numElementsSTArray :: STArray s i e -> Int
numElementsSTArray :: STArray s i e -> Int
numElementsSTArray = STArray s i e -> Int
forall s i e. STArray s i e -> Int
STArray.numElementsSTArray
{-# INLINE readSTArray #-}
readSTArray :: (Ix i, Applicative m) =>
STArray s i e -> i -> STT s m e
readSTArray :: STArray s i e -> i -> STT s m e
readSTArray arr :: STArray s i e
arr i :: i
i = ST s e -> STT s m e
forall (m :: * -> *) s a. Applicative m => ST s a -> STT s m a
liftST (STArray s i e -> i -> ST s e
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STArray s i e
arr i
i)
{-# INLINE unsafeReadSTArray #-}
unsafeReadSTArray :: (
#if __GLASGOW_HASKELL__ <= 710
Ix i,
#endif
Applicative m) =>
STArray s i e -> Int -> STT s m e
unsafeReadSTArray :: STArray s i e -> Int -> STT s m e
unsafeReadSTArray arr :: STArray s i e
arr i :: Int
i = ST s e -> STT s m e
forall (m :: * -> *) s a. Applicative m => ST s a -> STT s m a
liftST (STArray s i e -> Int -> ST s e
forall s i e. STArray s i e -> Int -> ST s e
STArray.unsafeReadSTArray STArray s i e
arr Int
i)
{-# INLINE writeSTArray #-}
writeSTArray :: (Ix i, Applicative m) =>
STArray s i e -> i -> e -> STT s m ()
writeSTArray :: STArray s i e -> i -> e -> STT s m ()
writeSTArray arr :: STArray s i e
arr i :: i
i e :: e
e = ST s () -> STT s m ()
forall (m :: * -> *) s a. Applicative m => ST s a -> STT s m a
liftST (STArray s i e -> i -> e -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s i e
arr i
i e
e)
{-# INLINE unsafeWriteSTArray #-}
unsafeWriteSTArray :: (
#if __GLASGOW_HASKELL__ <= 710
Ix i,
#endif
Applicative m) =>
STArray s i e -> Int -> e -> STT s m ()
unsafeWriteSTArray :: STArray s i e -> Int -> e -> STT s m ()
unsafeWriteSTArray arr :: STArray s i e
arr i :: Int
i e :: e
e = ST s () -> STT s m ()
forall (m :: * -> *) s a. Applicative m => ST s a -> STT s m a
liftST (STArray s i e -> Int -> e -> ST s ()
forall s i e. STArray s i e -> Int -> e -> ST s ()
STArray.unsafeWriteSTArray STArray s i e
arr Int
i e
e)
{-# INLINE freezeSTArray #-}
freezeSTArray :: (
#if __GLASGOW_HASKELL__ <= 710
Ix i,
#endif
Applicative m) =>
STArray s i e -> STT s m (Array i e)
freezeSTArray :: STArray s i e -> STT s m (Array i e)
freezeSTArray arr :: STArray s i e
arr = ST s (Array i e) -> STT s m (Array i e)
forall (m :: * -> *) s a. Applicative m => ST s a -> STT s m a
liftST (STArray s i e -> ST s (Array i e)
forall s i e. STArray s i e -> ST s (Array i e)
STArray.freezeSTArray STArray s i e
arr)
{-# INLINE unsafeFreezeSTArray #-}
unsafeFreezeSTArray :: (
#if __GLASGOW_HASKELL__ <= 710
Ix i,
#endif
Applicative m) =>
STArray s i e -> STT s m (Array i e)
unsafeFreezeSTArray :: STArray s i e -> STT s m (Array i e)
unsafeFreezeSTArray arr :: STArray s i e
arr = ST s (Array i e) -> STT s m (Array i e)
forall (m :: * -> *) s a. Applicative m => ST s a -> STT s m a
liftST (STArray s i e -> ST s (Array i e)
forall s i e. STArray s i e -> ST s (Array i e)
STArray.unsafeFreezeSTArray STArray s i e
arr)
{-# INLINE thawSTArray #-}
thawSTArray :: (
#if __GLASGOW_HASKELL__ <= 710
Ix i,
#endif
Applicative m) =>
Array i e -> STT s m (STArray s i e)
thawSTArray :: Array i e -> STT s m (STArray s i e)
thawSTArray arr :: Array i e
arr = ST s (STArray s i e) -> STT s m (STArray s i e)
forall (m :: * -> *) s a. Applicative m => ST s a -> STT s m a
liftST (Array i e -> ST s (STArray s i e)
forall i e s. Array i e -> ST s (STArray s i e)
STArray.thawSTArray Array i e
arr)
{-# INLINE unsafeThawSTArray #-}
unsafeThawSTArray :: (
#if __GLASGOW_HASKELL__ <= 710
Ix i,
#endif
Applicative m) =>
Array i e -> STT s m (STArray s i e)
unsafeThawSTArray :: Array i e -> STT s m (STArray s i e)
unsafeThawSTArray arr :: Array i e
arr = ST s (STArray s i e) -> STT s m (STArray s i e)
forall (m :: * -> *) s a. Applicative m => ST s a -> STT s m a
liftST (Array i e -> ST s (STArray s i e)
forall i e s. Array i e -> ST s (STArray s i e)
STArray.unsafeThawSTArray Array i e
arr)
{-# INLINE runSTArray #-}
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 :: (forall s. STT s m (STArray s i e)) -> m (Array i e)
runSTArray st :: forall s. STT s m (STArray s i e)
st = (forall s. STT s m (Array i e)) -> m (Array i e)
forall (m :: * -> *) a. Monad m => (forall s. STT s m a) -> m a
runSTT (STT s m (STArray s i e)
forall s. STT s m (STArray s i e)
st STT s m (STArray s i e)
-> (STArray s i e -> STT s m (Array i e)) -> STT s m (Array i e)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STArray s i e -> STT s m (Array i e)
forall (m :: * -> *) s i e.
Applicative m =>
STArray s i e -> STT s m (Array i e)
unsafeFreezeSTArray)
{-# NOINLINE unsafeIOToSTT #-}
unsafeIOToSTT :: (Monad m) => IO a -> STT s m a
unsafeIOToSTT :: IO a -> STT s m a
unsafeIOToSTT m :: IO a
m = a -> STT s m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> STT s m a) -> a -> STT s m a
forall a b. (a -> b) -> a -> b
$! IO a -> a
forall a. IO a -> a
unsafePerformIO IO a
m
{-# DEPRECATED unsafeSTToIO "Use unsafeSTTToIO instead" #-}
unsafeSTToIO :: STT s IO a -> IO a
unsafeSTToIO :: STT s IO a -> IO a
unsafeSTToIO m :: STT s IO a
m = (forall s. STT s IO a) -> IO a
forall (m :: * -> *) a. Monad m => (forall s. STT s m a) -> m a
runSTT ((forall s. STT s IO a) -> IO a) -> (forall s. STT s IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ STT s IO a -> STT s IO a
forall a b. a -> b
unsafeCoerce STT s IO a
m
unsafeSTTToIO :: STT s IO a -> IO a
unsafeSTTToIO :: STT s IO a -> IO a
unsafeSTTToIO m :: STT s IO a
m = (forall s. STT s IO a) -> IO a
forall (m :: * -> *) a. Monad m => (forall s. STT s m a) -> m a
runSTT ((forall s. STT s IO a) -> IO a) -> (forall s. STT s IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ STT s IO a -> STT s IO a
forall a b. a -> b
unsafeCoerce STT s IO a
m
unsafeSTRefToIORef :: STRef s a -> IORef a
unsafeSTRefToIORef :: STRef s a -> IORef a
unsafeSTRefToIORef ref :: STRef s a
ref = STRef s a -> IORef a
forall a b. a -> b
unsafeCoerce STRef s a
ref
unsafeIORefToSTRef :: IORef a -> STRef s a
unsafeIORefToSTRef :: IORef a -> STRef s a
unsafeIORefToSTRef ref :: IORef a
ref = IORef a -> STRef s a
forall a b. a -> b
unsafeCoerce IORef a
ref