X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FST.lhs;h=dc62000a217766763aa24bf0aac9f891cde9d82b;hb=be2750a0a11b919fb03cc070074e430f88bdfa90;hp=cdccb18204d1637287b1bfe366d49a1576a40bd4;hpb=d9a0d6f44a930da4ae49678908e37793d693467c;p=ghc-base.git diff --git a/GHC/ST.lhs b/GHC/ST.lhs index cdccb18..dc62000 100644 --- a/GHC/ST.lhs +++ b/GHC/ST.lhs @@ -1,5 +1,6 @@ \begin{code} -{-# OPTIONS_GHC -fno-implicit-prelude #-} +{-# LANGUAGE NoImplicitPrelude, MagicHash, UnboxedTuples, Rank2Types #-} +{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.ST @@ -19,15 +20,14 @@ module GHC.ST where import GHC.Base import GHC.Show -import GHC.Num default () \end{code} %********************************************************* -%* * +%* * \subsection{The @ST@ monad} -%* * +%* * %********************************************************* The state-transformer monad proper. By default the monad is strict; @@ -39,13 +39,18 @@ too many people got bitten by space leaks when it was lazy. -- by @s@, and returns a value of type @a@. -- The @s@ parameter is either -- --- * an unstantiated type variable (inside invocations of 'runST'), or +-- * 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 #) @@ -63,9 +68,9 @@ instance Monad (ST s) where (ST m) >>= k = ST (\ s -> - case (m s) of { (# new_s, r #) -> - case (k r) of { ST k2 -> - (k2 new_s) }}) + case (m s) of { (# new_s, r #) -> + case (k r) of { ST k2 -> + (k2 new_s) }}) data STret s a = STret (State# s) a @@ -78,7 +83,7 @@ liftST (ST m) = \s -> case m s of (# s', r #) -> STret s' r unsafeInterleaveST :: ST s a -> ST s a unsafeInterleaveST (ST m) = ST ( \ s -> let - r = case m s of (# _, res #) -> res + r = case m s of (# _, res #) -> res in (# s, r #) ) @@ -89,13 +94,13 @@ unsafeInterleaveST (ST m) = ST ( \ s -> fixST :: (a -> ST s a) -> ST s a fixST k = ST $ \ s -> let ans = liftST (k r) s - STret _ r = ans + STret _ r = ans in case ans of STret s' x -> (# s', x #) instance Show (ST s a) where showsPrec _ _ = showString "<>" - showList = showList__ (showsPrec 0) + showList = showList__ (showsPrec 0) \end{code} Definition of runST @@ -105,16 +110,16 @@ 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'' ) + (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' + (a, s') = newArray# 100 [] realWorld#{-NB-} + (_, s'') = fill_in_array_or_something a x s' in freezeArray# a s'' \end{verbatim} @@ -125,8 +130,8 @@ 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'' + 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. @@ -144,9 +149,16 @@ 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 [0]" says. --- SLPJ Apr 99 -{-# INLINE [0] runSTRep #-} +-- SLPJ Apr 99 +-- {-# INLINE [0] runSTRep #-} + +-- SDM: further to the above, inline phase 0 is run *before* +-- full-laziness at the moment, which means that the above comment is +-- invalid. Inlining runSTRep doesn't make a huge amount of +-- difference, anyway. Hence: + +{-# NOINLINE runSTRep #-} runSTRep :: (forall s. STRep s a) -> a runSTRep st_rep = case st_rep realWorld# of - (# _, r #) -> r + (# _, r #) -> r \end{code}