From 6bfd2f54231675165b3345689f41ab77db0bbba9 Mon Sep 17 00:00:00 2001
From: simonm <unknown>
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 e0532cc5b480..b77f87e8e28f 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 e3bb80cda0e6..7a4c57a66fff 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 f829447aa557..b524d39b4ef6 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 75140b8cf3b2..59caea7592b2 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 806b93204da1..b25ecaa64037 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 7a5c6d27a166..6a78c842a565 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 c80b941f4607..ee00d07cef35 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 f8c8cf818175..93b26d637c9a 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 0c7834a24752..d76b79276b51 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 39b4a235a35c..74731bb77948 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 8513a6a4b2db..580ec93c9075 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 d85c63903cf3..000000000000
--- 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 17feed9b4049..000000000000
--- 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 562f6f535e55..65eca106f898 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 )
--
GitLab