module PrelST where
import Monad
+import PrelShow
import PrelBase
import PrelGHC
+import PrelNum () -- So that we get the .hi file for system imports
+
+default ()
\end{code}
%*********************************************************
too many people got bitten by space leaks when it was lazy.
\begin{code}
-newtype ST s a = ST (State# s -> STret s a)
+newtype ST s a = ST (STRep s a)
+type STRep s a = State# s -> (# State# s, a #)
-data STret s a = STret (State# s) a
+instance Functor (ST s) where
+ fmap f (ST m) = ST $ \ s ->
+ case (m s) of { (# new_s, r #) ->
+ (# new_s, f r #) }
instance Monad (ST s) where
{-# INLINE return #-}
{-# INLINE (>>) #-}
{-# INLINE (>>=) #-}
- return x = ST $ \ s -> STret s x
+ return x = ST $ \ s -> (# s, x #)
m >> k = m >>= \ _ -> k
(ST m) >>= k
= ST $ \ s ->
- case (m s) of { STret new_s r ->
+ case (m s) of { (# new_s, r #) ->
case (k r) of { ST k2 ->
(k2 new_s) }}
+data STret s a = STret (State# s) a
+-- liftST is useful when we want a lifted result from an ST computation. See
+-- fixST below.
+liftST :: ST s a -> State# s -> STret s a
+liftST (ST m) = \s -> case m s of (# s', r #) -> STret s' r
-fixST :: (a -> ST s a) -> ST s a
-fixST k = ST $ \ s ->
- let (ST k_r) = k r
- ans = k_r s
- STret _ r = ans
+{-# NOINLINE unsafeInterleaveST #-}
+unsafeInterleaveST :: ST s a -> ST s a
+unsafeInterleaveST (ST m) = ST ( \ s ->
+ let
+ r = case m s of (# _, res #) -> res
in
- ans
+ (# s, r #)
+ )
+instance Show (ST s a) where
+ showsPrec _ _ = showString "<<ST action>>"
+ showList = showList__ (showsPrec 0)
\end{code}
-
-%*********************************************************
-%* *
-\subsection{Ghastly return types}
-%* *
-%*********************************************************
-
-The @State@ type is the return type of a _ccall_ with no result. It
-never actually exists, since it's always deconstructed straight away;
-the desugarer ensures this.
+Definition of runST
+~~~~~~~~~~~~~~~~~~~
+
+SLPJ 95/04: Why @runST@ must not have an unfolding; consider:
+\begin{verbatim}
+f x =
+ runST ( \ s -> let
+ (a, s') = newArray# 100 [] s
+ (_, s'') = fill_in_array_or_something a x s'
+ in
+ freezeArray# a s'' )
+\end{verbatim}
+If we inline @runST@, we'll get:
+\begin{verbatim}
+f x = let
+ (a, s') = newArray# 100 [] realWorld#{-NB-}
+ (_, s'') = fill_in_array_or_something a x s'
+ in
+ freezeArray# a s''
+\end{verbatim}
+And now the @newArray#@ binding can be floated to become a CAF, which
+is totally and utterly wrong:
+\begin{verbatim}
+f = let
+ (a, s') = newArray# 100 [] realWorld#{-NB-} -- YIKES!!!
+ in
+ \ x ->
+ let (_, s'') = fill_in_array_or_something a x s' in
+ freezeArray# a s''
+\end{verbatim}
+All calls to @f@ will share a {\em single} array! End SLPJ 95/04.
\begin{code}
-data State s = S# (State# s)
-data StateAndPtr# s elt = StateAndPtr# (State# s) elt
-
-data StateAndChar# s = StateAndChar# (State# s) Char#
-data StateAndInt# s = StateAndInt# (State# s) Int#
-data StateAndWord# s = StateAndWord# (State# s) Word#
-data StateAndFloat# s = StateAndFloat# (State# s) Float#
-data StateAndDouble# s = StateAndDouble# (State# s) Double#
-data StateAndAddr# s = StateAndAddr# (State# s) Addr#
+{-# INLINE runST #-}
+-- The INLINE prevents runSTRep getting inlined in *this* module
+-- so that it is still visible when runST is inlined in an importing
+-- module. Regrettably delicate. runST is behaving like a wrapper.
+runST :: (forall s. ST s a) -> a
+runST st = runSTRep (case st of { ST st_rep -> st_rep })
+
+-- I'm only letting runSTRep be inlined right at the end, in particular *after* full laziness
+-- That's what the "INLINE 100" says.
+-- SLPJ Apr 99
+{-# INLINE 100 runSTRep #-}
+runSTRep :: (forall s. STRep s a) -> a
+runSTRep st_rep = case st_rep realWorld# of
+ (# _, r #) -> r
\end{code}