From 6bfd2f54231675165b3345689f41ab77db0bbba9 Mon Sep 17 00:00:00 2001 From: simonm Date: Fri, 22 May 1998 15:57:28 +0000 Subject: [PATCH] [project @ 1998-05-22 15:57:05 by simonm] - Add NOINLINE pragmas to the unsafe things (unsafe*IO, unsafe*ST, runST etc.) - Move unsafe function back into the proper modules - Remove PrelUnsafe*.lhs --- ghc/lib/std/CPUTime.lhs | 1 - ghc/lib/std/Directory.lhs | 1 - ghc/lib/std/IO.lhs | 1 - ghc/lib/std/Makefile | 6 ---- ghc/lib/std/PrelArr.lhs | 1 - ghc/lib/std/PrelForeign.lhs | 1 - ghc/lib/std/PrelHandle.lhs | 1 - ghc/lib/std/PrelIOBase.lhs | 34 ++++++++++++++++++ ghc/lib/std/PrelNum.lhs | 2 +- ghc/lib/std/PrelPack.lhs | 1 - ghc/lib/std/PrelST.lhs | 48 +++++++++++++++++++++++++ ghc/lib/std/PrelUnsafe.lhs | 79 ------------------------------------------ ghc/lib/std/PrelUnsafeST.lhs | 68 ------------------------------------ ghc/lib/std/Time.lhs | 1 - 14 files changed, 83 insertions(+), 162 deletions(-) delete mode 100644 ghc/lib/std/PrelUnsafe.lhs delete mode 100644 ghc/lib/std/PrelUnsafeST.lhs diff --git a/ghc/lib/std/CPUTime.lhs b/ghc/lib/std/CPUTime.lhs index e0532cc..b77f87e 100644 --- a/ghc/lib/std/CPUTime.lhs +++ b/ghc/lib/std/CPUTime.lhs @@ -19,7 +19,6 @@ import PrelNum import PrelAddr import PrelIOBase import IO -import PrelUnsafe ( unsafePerformIO ) import PrelST import Ratio diff --git a/ghc/lib/std/Directory.lhs b/ghc/lib/std/Directory.lhs index e3bb80c..7a4c57a 100644 --- a/ghc/lib/std/Directory.lhs +++ b/ghc/lib/std/Directory.lhs @@ -42,7 +42,6 @@ module Directory import PrelBase import PrelIOBase import PrelST -import PrelUnsafe ( unsafePerformIO ) import PrelArr import PrelPack ( unpackNBytesST ) import PrelForeign ( Word(..) ) diff --git a/ghc/lib/std/IO.lhs b/ghc/lib/std/IO.lhs index f829447..b524d39 100644 --- a/ghc/lib/std/IO.lhs +++ b/ghc/lib/std/IO.lhs @@ -33,7 +33,6 @@ module IO ( ) where import PrelST -import PrelUnsafe ( unsafePerformIO, unsafeInterleaveIO ) import PrelIOBase import PrelArr ( MutableByteArray(..), newCharArray ) import PrelHandle -- much of the real stuff is in here diff --git a/ghc/lib/std/Makefile b/ghc/lib/std/Makefile index 75140b8..59caea7 100644 --- a/ghc/lib/std/Makefile +++ b/ghc/lib/std/Makefile @@ -54,12 +54,6 @@ Time_HC_OPTS += -monly-3-regs -H16m # Far too much heap is needed to compile PrelNum with -O at the # moment, but there you go.. PrelNum_HC_OPTS += -H30m -# Note: this option has to go in the Makefile rather than in an -# OPTIONS line in the source file. The reason being that we want -# to override the SRC_HC_OPTS of -O, and anything option coming -# from the Makefile overrides what's in OPTIONS lines. (mumble_HC_OPTS -# does override SRC_HC_OPTS settings) -PrelUnsafe_HC_OPTS += -Onot PrelBase_HC_OPTS += -H12m PrelRead_HC_OPTS += -H13m diff --git a/ghc/lib/std/PrelArr.lhs b/ghc/lib/std/PrelArr.lhs index 806b932..b25ecaa 100644 --- a/ghc/lib/std/PrelArr.lhs +++ b/ghc/lib/std/PrelArr.lhs @@ -18,7 +18,6 @@ import PrelST import PrelBase import PrelCCall import PrelAddr -import PrelUnsafeST ( runST ) import PrelGHC infixl 9 !, // diff --git a/ghc/lib/std/PrelForeign.lhs b/ghc/lib/std/PrelForeign.lhs index 7a5c6d2..6a78c84 100644 --- a/ghc/lib/std/PrelForeign.lhs +++ b/ghc/lib/std/PrelForeign.lhs @@ -24,7 +24,6 @@ module PrelForeign ( import PrelIOBase import PrelST -import PrelUnsafe import PrelBase import PrelCCall import PrelAddr diff --git a/ghc/lib/std/PrelHandle.lhs b/ghc/lib/std/PrelHandle.lhs index c80b941..ee00d07 100644 --- a/ghc/lib/std/PrelHandle.lhs +++ b/ghc/lib/std/PrelHandle.lhs @@ -19,7 +19,6 @@ import PrelArr ( ByteArray(..), newVar, readVar, writeVar ) import PrelRead ( Read ) import PrelList ( span ) import PrelIOBase -import PrelUnsafe ( unsafePerformIO ) import PrelTup import PrelMaybe import PrelBase diff --git a/ghc/lib/std/PrelIOBase.lhs b/ghc/lib/std/PrelIOBase.lhs index f8c8cf8..93b26d6 100644 --- a/ghc/lib/std/PrelIOBase.lhs +++ b/ghc/lib/std/PrelIOBase.lhs @@ -393,3 +393,37 @@ data BufferMode performGC :: IO () performGC = _ccall_GC_ StgPerformGarbageCollection \end{code} + +%********************************************************* +%* * +\subsection{Unsafe @IO@ operations} +%* * +%********************************************************* + +\begin{code} +{-# NOINLINE unsafePerformIO #-} +unsafePerformIO :: IO a -> a +unsafePerformIO (IO m) + = case m realWorld# of + IOok _ r -> r + IOfail _ e -> error ("unsafePerformIO: I/O error: " ++ show e ++ "\n") + +{-# NOINLINE unsafeInterleaveIO #-} +unsafeInterleaveIO :: IO a -> IO a +unsafeInterleaveIO (IO m) = IO ( \ s -> + let + IOok _ r = m s + in + IOok s r) + +{-# NOINLINE trace #-} +trace :: String -> a -> a +trace string expr + = unsafePerformIO ( + ((_ccall_ PreTraceHook sTDERR{-msg-}):: IO ()) >> + fputs sTDERR string >> + ((_ccall_ PostTraceHook sTDERR{-msg-}):: IO ()) >> + return expr ) + where + sTDERR = (``stderr'' :: Addr) +\end{code} diff --git a/ghc/lib/std/PrelNum.lhs b/ghc/lib/std/PrelNum.lhs index 0c7834a..d76b792 100644 --- a/ghc/lib/std/PrelNum.lhs +++ b/ghc/lib/std/PrelNum.lhs @@ -26,7 +26,7 @@ import PrelList import PrelMaybe import PrelArr ( Array, array, (!) ) -import PrelUnsafe ( unsafePerformIO ) +import PrelIOBase ( unsafePerformIO ) import Ix ( Ix(..) ) import PrelCCall () -- we need the definitions of CCallable and -- CReturnable for the _ccall_s herein. diff --git a/ghc/lib/std/PrelPack.lhs b/ghc/lib/std/PrelPack.lhs index 39b4a23..74731bb 100644 --- a/ghc/lib/std/PrelPack.lhs +++ b/ghc/lib/std/PrelPack.lhs @@ -52,7 +52,6 @@ import PrelList ( length ) import PrelST import PrelArr import PrelAddr -import PrelUnsafeST ( runST ) \end{code} diff --git a/ghc/lib/std/PrelST.lhs b/ghc/lib/std/PrelST.lhs index 8513a6a..580ec93 100644 --- a/ghc/lib/std/PrelST.lhs +++ b/ghc/lib/std/PrelST.lhs @@ -55,8 +55,56 @@ fixST k = ST $ \ s -> in ans +{-# NOINLINE unsafeInterleaveST #-} +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} +{-# NOINLINE runST #-} +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/std/PrelUnsafe.lhs b/ghc/lib/std/PrelUnsafe.lhs deleted file mode 100644 index d85c639..0000000 --- a/ghc/lib/std/PrelUnsafe.lhs +++ /dev/null @@ -1,79 +0,0 @@ -% -% (c) The AQUA Project, Glasgow University, 1994-1996 -% - -\section[PrelUnsafe]{Module @PrelUnsafe@} - -These functions have their own module because we definitely don't want -them to be inlined. The reason is that we may end up turning an action -into a constant when it is not: - - new :: IORef Int - new = - let - foo = unsafePerformIO getNextValue - in - newIORef foo - -If unsafePerformIO is inlined here, the application of getNextValue to the realWorld# -token might be floated out, leaving us with - - foo' = getNextValue realWorld# - - new :: IORef Int - new = newIORef foo' - -which is not what we want. - -\begin{code} -{-# OPTIONS -fno-implicit-prelude #-} - -module PrelUnsafe - ( unsafePerformIO, - unsafeInterleaveIO, - trace, - ) where -\end{code} - -\begin{code} -import PrelBase -import PrelIOBase -import PrelAddr -import {-# SOURCE #-} PrelErr ( error ) -\end{code} - -%********************************************************* -%* * -\subsection{Unsafe @IO@ operations} -%* * -%********************************************************* - -\begin{code} -unsafePerformIO :: IO a -> a -unsafePerformIO (IO m) - = case m realWorld# of - IOok _ r -> r - IOfail _ e -> error ("unsafePerformIO: I/O error: " ++ show e ++ "\n") - -unsafeInterleaveIO :: IO a -> IO a -unsafeInterleaveIO (IO m) = IO ( \ s -> - let - res = - case m s of - IOok _ r -> r - IOfail _ e -> error ("unsafeInterleaveIO: I/O error: " ++ show e ++ "\n") - in - IOok s res - ) - - -trace :: String -> a -> a -trace string expr - = unsafePerformIO ( - ((_ccall_ PreTraceHook sTDERR{-msg-}):: IO ()) >> - fputs sTDERR string >> - ((_ccall_ PostTraceHook sTDERR{-msg-}):: IO ()) >> - return expr ) - where - sTDERR = (``stderr'' :: Addr) -\end{code} diff --git a/ghc/lib/std/PrelUnsafeST.lhs b/ghc/lib/std/PrelUnsafeST.lhs deleted file mode 100644 index 17feed9..0000000 --- a/ghc/lib/std/PrelUnsafeST.lhs +++ /dev/null @@ -1,68 +0,0 @@ -% -% (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 PrelUnsafeST (unsafeInterleaveST, runST) where - -import PrelST -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} - diff --git a/ghc/lib/std/Time.lhs b/ghc/lib/std/Time.lhs index 562f6f5..65eca10 100644 --- a/ghc/lib/std/Time.lhs +++ b/ghc/lib/std/Time.lhs @@ -37,7 +37,6 @@ import PrelBase import PrelIOBase import PrelArr import PrelST -import PrelUnsafe ( unsafePerformIO ) import PrelAddr import PrelPack ( unpackCString ) -- 1.7.10.4