From 47e446c74eb726d30fdc51a4352cdc1903b75754 Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Sat, 16 May 1998 20:01:18 +0000
Subject: [PATCH] [project @ 1998-05-16 20:01:18 by sof] unsafeInterleaveIO:
handle I/O failure a little bit more gracefully
---
ghc/lib/std/PrelUnsafe.lhs | 31 ++++++++++++++++++++++++++-----
1 file changed, 26 insertions(+), 5 deletions(-)
diff --git a/ghc/lib/std/PrelUnsafe.lhs b/ghc/lib/std/PrelUnsafe.lhs
index 775582c18dec..d85c63903cf3 100644
--- a/ghc/lib/std/PrelUnsafe.lhs
+++ b/ghc/lib/std/PrelUnsafe.lhs
@@ -5,7 +5,25 @@
\section[PrelUnsafe]{Module @PrelUnsafe@}
These functions have their own module because we definitely don't want
-them to be inlined.
+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 #-}
@@ -40,11 +58,15 @@ unsafePerformIO (IO m)
unsafeInterleaveIO :: IO a -> IO a
unsafeInterleaveIO (IO m) = IO ( \ s ->
let
- IOok _ r = m s
+ res =
+ case m s of
+ IOok _ r -> r
+ IOfail _ e -> error ("unsafeInterleaveIO: I/O error: " ++ show e ++ "\n")
in
- IOok s r)
+ IOok s res
+ )
+
-{-# GENERATE_SPECS _trace a #-}
trace :: String -> a -> a
trace string expr
= unsafePerformIO (
@@ -55,4 +77,3 @@ trace string expr
where
sTDERR = (``stderr'' :: Addr)
\end{code}
-
--
GitLab