diff options
Diffstat (limited to 'libraries')
| -rw-r--r-- | libraries/base/GHC/IO.hs | 5 | ||||
| -rw-r--r-- | libraries/base/GHC/ST.hs | 58 | ||||
| -rw-r--r-- | libraries/ghc-prim/GHC/Magic.hs | 19 | ||||
| -rw-r--r-- | libraries/ghc-prim/changelog.md | 1 | ||||
| -rw-r--r-- | libraries/integer-gmp/src/GHC/Integer/Type.hs | 3 |
5 files changed, 24 insertions, 62 deletions
diff --git a/libraries/base/GHC/IO.hs b/libraries/base/GHC/IO.hs index 1e8c74e5c1..f38c88f009 100644 --- a/libraries/base/GHC/IO.hs +++ b/libraries/base/GHC/IO.hs @@ -176,11 +176,8 @@ like 'bracket' cannot be used safely within 'unsafeDupablePerformIO'. @since 4.4.0.0 -} -{-# NOINLINE unsafeDupablePerformIO #-} - -- See Note [unsafeDupablePerformIO is NOINLINE] unsafeDupablePerformIO :: IO a -> a -unsafeDupablePerformIO (IO m) = lazy (case m realWorld# of (# _, r #) -> r) - -- See Note [unsafeDupablePerformIO has a lazy RHS] +unsafeDupablePerformIO (IO m) = case runRW# m of (# _, a #) -> a -- Note [unsafeDupablePerformIO is NOINLINE] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/libraries/base/GHC/ST.hs b/libraries/base/GHC/ST.hs index 46c5196c9e..d84dd4d9d1 100644 --- a/libraries/base/GHC/ST.hs +++ b/libraries/base/GHC/ST.hs @@ -18,7 +18,7 @@ module GHC.ST ( ST(..), STret(..), STRep, - fixST, runST, runSTRep, + fixST, runST, -- * Unsafe functions liftST, unsafeInterleaveST @@ -103,62 +103,10 @@ instance Show (ST s a) where showsPrec _ _ = showString "<<ST action>>" showList = showList__ (showsPrec 0) -{- -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. --} - {-# 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. - -- | Return the value computed by a state transformer computation. -- 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 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 #-} - --- 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 +runST (ST st_rep) = case runRW# st_rep of (# _, a #) -> a +-- See Note [Definition of runRW#] in GHC.Magic diff --git a/libraries/ghc-prim/GHC/Magic.hs b/libraries/ghc-prim/GHC/Magic.hs index 740abb729e..495705b3b4 100644 --- a/libraries/ghc-prim/GHC/Magic.hs +++ b/libraries/ghc-prim/GHC/Magic.hs @@ -1,5 +1,9 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + ----------------------------------------------------------------------------- -- | -- Module : GHC.Magic @@ -17,8 +21,9 @@ -- ----------------------------------------------------------------------------- -module GHC.Magic ( inline, lazy, oneShot ) where +module GHC.Magic ( inline, lazy, oneShot, runRW# ) where +import GHC.Prim import GHC.CString () -- | The call @inline f@ arranges that 'f' is inlined, regardless of @@ -82,3 +87,15 @@ oneShot :: (a -> b) -> (a -> b) oneShot f = f -- Implementation note: This is wired in in MkId.lhs, so the code here is -- mostly there to have a place for the documentation. + +-- | Apply a function to a 'RealWorld' token. +runRW# :: (State# RealWorld -> (# State# RealWorld, o #)) + -> (# State# RealWorld, o #) +-- See Note [runRW magic] in MkId +#if !defined(__HADDOCK_VERSION__) +runRW# m = m realWorld# +#else +runRW# = runRW# -- The realWorld# is too much for haddock +#endif +{-# NOINLINE runRW# #-} +-- This is inlined manually in CorePrep diff --git a/libraries/ghc-prim/changelog.md b/libraries/ghc-prim/changelog.md index 2e4288622b..45daa64b26 100644 --- a/libraries/ghc-prim/changelog.md +++ b/libraries/ghc-prim/changelog.md @@ -27,6 +27,7 @@ getSizeofMutableByteArray# :: MutableByteArray# d -> State# d -> (# State# d, Int# #) subWordC# :: Word# -> Word# -> (# Word#, Int# #) + runRW# :: (State# RealWorld -> (# State# RealWorld, o #)) -> (# State# RealWorld, o #) - Added to `GHC.Types`: diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs index 5bc52539fd..167492d34d 100644 --- a/libraries/integer-gmp/src/GHC/Integer/Type.hs +++ b/libraries/integer-gmp/src/GHC/Integer/Type.hs @@ -1934,8 +1934,7 @@ liftIO (IO m) = m -- NB: equivalent of GHC.IO.unsafeDupablePerformIO, see notes there runS :: S RealWorld a -> a -runS m = lazy (case m realWorld# of (# _, r #) -> r) -{-# NOINLINE runS #-} +runS m = case runRW# m of (# _, a #) -> a -- stupid hack fail :: [Char] -> S s a |