{-# LANGUAGE Unsafe #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples, RankNTypes #-}
{-# OPTIONS_HADDOCK not-home #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.ST
-- Copyright   :  (c) The University of Glasgow, 1992-2002
-- License     :  see libraries/base/LICENSE
--
-- Maintainer  :  cvs-ghc@haskell.org
-- Stability   :  internal
-- Portability :  non-portable (GHC Extensions)
--
-- The 'ST' Monad.
--
-----------------------------------------------------------------------------

module GHC.ST (
        ST(..), STret(..), STRep,
        runST,

        -- * Unsafe functions
        liftST, unsafeInterleaveST, unsafeDupableInterleaveST
    ) where

import GHC.Base
import GHC.Show
import Control.Monad.Fail

default ()

-- The 'ST' monad proper.  By default the monad is strict;
-- too many people got bitten by space leaks when it was lazy.

-- | The strict 'ST' monad.
-- The 'ST' monad allows for destructive updates, but is escapable (unlike IO).
-- A computation of type @'ST' s a@ returns a value of type @a@, and
-- execute in "thread" @s@. The @s@ parameter is either
--
-- * an uninstantiated type variable (inside invocations of 'runST'), or
--
-- * 'RealWorld' (inside invocations of 'Control.Monad.ST.stToIO').
--
-- It serves to keep the internal states of different invocations
-- of 'runST' separate from each other and from invocations of
-- 'Control.Monad.ST.stToIO'.
--
-- The '>>=' and '>>' operations are strict in the state (though not in
-- values stored in the state).  For example,
--
-- @'runST' (writeSTRef _|_ v >>= f) = _|_@
newtype ST s a = ST (STRep s a)
type STRep s a = State# s -> (# State# s, a #)

-- | @since 2.01
instance Functor (ST s) where
    fmap :: forall a b. (a -> b) -> ST s a -> ST s b
fmap a -> b
f (ST STRep s a
m) = STRep s b -> ST s b
forall s a. STRep s a -> ST s a
ST (STRep s b -> ST s b) -> STRep s b -> ST s b
forall a b. (a -> b) -> a -> b
$ \ State# s
s ->
      case (STRep s a
m State# s
s) of { (# State# s
new_s, a
r #) ->
      (# State# s
new_s, a -> b
f a
r #) }

-- | @since 4.4.0.0
instance Applicative (ST s) where
    {-# INLINE pure #-}
    {-# INLINE (*>)   #-}
    pure :: forall a. a -> ST s a
pure a
x = STRep s a -> ST s a
forall s a. STRep s a -> ST s a
ST (\ State# s
s -> (# State# s
s, a
x #))
    ST s a
m *> :: forall a b. ST s a -> ST s b -> ST s b
*> ST s b
k = ST s a
m ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ a
_ -> ST s b
k
    <*> :: forall a b. ST s (a -> b) -> ST s a -> ST s b
(<*>) = ST s (a -> b) -> ST s a -> ST s b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
    liftA2 :: forall a b c. (a -> b -> c) -> ST s a -> ST s b -> ST s c
liftA2 = (a -> b -> c) -> ST s a -> ST s b -> ST s c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2

-- | @since 2.01
instance Monad (ST s) where
    {-# INLINE (>>=)  #-}
    >> :: forall a b. ST s a -> ST s b -> ST s b
(>>) = ST s a -> ST s b -> ST s b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
    (ST STRep s a
m) >>= :: forall a b. ST s a -> (a -> ST s b) -> ST s b
>>= a -> ST s b
k
      = STRep s b -> ST s b
forall s a. STRep s a -> ST s a
ST (\ State# s
s ->
        case (STRep s a
m State# s
s) of { (# State# s
new_s, a
r #) ->
        case (a -> ST s b
k a
r) of { ST STRep s b
k2 ->
        (STRep s b
k2 State# s
new_s) }})

-- | @since 4.11.0.0
instance MonadFail (ST s) where
    fail :: forall a. String -> ST s a
fail String
s = String -> ST s a
forall a. String -> a
errorWithoutStackTrace String
s

-- | @since 4.11.0.0
instance Semigroup a => Semigroup (ST s a) where
    <> :: ST s a -> ST s a -> ST s a
(<>) = (a -> a -> a) -> ST s a -> ST s a -> ST s a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)

-- | @since 4.11.0.0
instance Monoid a => Monoid (ST s a) where
    mempty :: ST s a
mempty = a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty

data STret s a = STret (State# s) a

-- liftST is useful when we want a lifted result from an ST computation.
liftST :: ST s a -> State# s -> STret s a
liftST :: forall s a. ST s a -> State# s -> STret s a
liftST (ST STRep s a
m) = \State# s
s -> case STRep s a
m State# s
s of (# State# s
s', a
r #) -> State# s -> a -> STret s a
forall s a. State# s -> a -> STret s a
STret State# s
s' a
r

noDuplicateST :: ST s ()
noDuplicateST :: forall s. ST s ()
noDuplicateST = STRep s () -> ST s ()
forall s a. STRep s a -> ST s a
ST (STRep s () -> ST s ()) -> STRep s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ \State# s
s -> (# State# s -> State# s
forall d. State# d -> State# d
noDuplicate# State# s
s, () #)

-- | 'unsafeInterleaveST' allows an 'ST' computation to be deferred
-- lazily.  When passed a value of type @ST a@, the 'ST' computation will
-- only be performed when the value of the @a@ is demanded.
{-# INLINE unsafeInterleaveST #-}
unsafeInterleaveST :: ST s a -> ST s a
unsafeInterleaveST :: forall s a. ST s a -> ST s a
unsafeInterleaveST ST s a
m = ST s a -> ST s a
forall s a. ST s a -> ST s a
unsafeDupableInterleaveST (ST s ()
forall s. ST s ()
noDuplicateST ST s () -> ST s a -> ST s a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ST s a
m)

-- | 'unsafeDupableInterleaveST' allows an 'ST' computation to be deferred
-- lazily.  When passed a value of type @ST a@, the 'ST' computation will
-- only be performed when the value of the @a@ is demanded.
--
-- The computation may be performed multiple times by different threads,
-- possibly at the same time. To prevent this, use 'unsafeInterleaveST' instead.
--
-- @since 4.11
{-# NOINLINE unsafeDupableInterleaveST #-}
-- See Note [unsafeDupableInterleaveIO should not be inlined]
-- in GHC.IO.Unsafe
unsafeDupableInterleaveST :: ST s a -> ST s a
unsafeDupableInterleaveST :: forall s a. ST s a -> ST s a
unsafeDupableInterleaveST (ST STRep s a
m) = STRep s a -> ST s a
forall s a. STRep s a -> ST s a
ST ( \ State# s
s ->
    let
        r :: a
r = case STRep s a
m State# s
s of (# State# s
_, a
res #) -> a
res
    in
    (# State# s
s, a
r #)
  )

-- | @since 2.01
instance  Show (ST s a)  where
    showsPrec :: Int -> ST s a -> ShowS
showsPrec Int
_ ST s a
_  = String -> ShowS
showString String
"<<ST action>>"
    showList :: [ST s a] -> ShowS
showList       = (ST s a -> ShowS) -> [ST s a] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showList__ (Int -> ST s a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0)

{-# INLINE runST #-}
-- | Return the value computed by a state thread.
-- The @forall@ ensures that the internal state used by the 'ST'
-- computation is inaccessible to the rest of the program.
runST :: (forall s. ST s a) -> a
runST :: forall a. (forall s. ST s a) -> a
runST (ST STRep RealWorld a
st_rep) = case STRep RealWorld a -> (# State# RealWorld, a #)
forall o. (State# RealWorld -> o) -> o
runRW# STRep RealWorld a
st_rep of (# State# RealWorld
_, a
a #) -> a
a
-- See Note [Definition of runRW#] in GHC.Magic