From: simonm Date: Thu, 4 Dec 1997 14:57:39 +0000 (+0000) Subject: [project @ 1997-12-04 14:57:34 by simonm] X-Git-Tag: Approx_2487_patches~1192 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=4e2bf823d13edfcd3e76e2b4754f83021adb13ce;p=ghc-hetmet.git [project @ 1997-12-04 14:57:34 by simonm] Pull runST and unsafeInterleaveST into UnsafeST to avoid recursive dependencies. Grrrrr. --- diff --git a/ghc/lib/ghc/ArrBase.lhs b/ghc/lib/ghc/ArrBase.lhs index 558d54c..4686421 100644 --- a/ghc/lib/ghc/ArrBase.lhs +++ b/ghc/lib/ghc/ArrBase.lhs @@ -18,7 +18,7 @@ import STBase import PrelBase import CCall import Addr -import Unsafe ( runST ) +import UnsafeST ( runST ) import GHC infixl 9 !, // diff --git a/ghc/lib/ghc/PackBase.lhs b/ghc/lib/ghc/PackBase.lhs index eaf4d6d..dc0a835 100644 --- a/ghc/lib/ghc/PackBase.lhs +++ b/ghc/lib/ghc/PackBase.lhs @@ -46,6 +46,7 @@ import PrelList ( length ) import STBase import ArrBase import Addr +import UnsafeST ( runST ) \end{code} diff --git a/ghc/lib/ghc/Unsafe.lhs b/ghc/lib/ghc/Unsafe.lhs index 1da8e25..1a145af 100644 --- a/ghc/lib/ghc/Unsafe.lhs +++ b/ghc/lib/ghc/Unsafe.lhs @@ -13,16 +13,13 @@ them to be inlined. module Unsafe ( unsafePerformIO, unsafeInterleaveIO, - unsafeInterleaveST, trace, - runST ) where \end{code} \begin{code} import PrelBase import IOBase -import STBase import Addr import {-# SOURCE #-} Error ( error ) \end{code} @@ -59,52 +56,3 @@ trace string expr sTDERR = (``stderr'' :: Addr) \end{code} -\begin{code} -unsafeInterleaveST :: ST s a -> ST s a -unsafeInterleaveST (ST m) = ST ( \ s -> - let - STret _ r = m s - in - STret s r) - -\end{code} - -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} -runST :: (All s => ST s a) -> a -runST st = - case st of - ST m -> case m realWorld# of - STret _ r -> r -\end{code} diff --git a/ghc/lib/ghc/UnsafeST.lhs b/ghc/lib/ghc/UnsafeST.lhs new file mode 100644 index 0000000..5565178 --- /dev/null +++ b/ghc/lib/ghc/UnsafeST.lhs @@ -0,0 +1,68 @@ +% +% (c) The AQUA Project, Glasgow University, 1994-1996 +% + +\section[UnsafeST]{Module @UnsafeST@} + +These functions have their own module because we definitely don't want +them to be inlined. + +\begin{code} +{-# OPTIONS -fno-implicit-prelude #-} + +module UnsafeST (unsafeInterleaveST, runST) where + +import STBase +import PrelBase +\end{code} + +\begin{code} +unsafeInterleaveST :: ST s a -> ST s a +unsafeInterleaveST (ST m) = ST ( \ s -> + let + STret _ r = m s + in + STret s r) + +\end{code} + +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} +runST :: (All s => ST s a) -> a +runST st = + case st of + ST m -> case m realWorld# of + STret _ r -> r +\end{code} +