Fix up exception handling when reading an interface file, and make it
compile with 4.08.x again.
GhcExceptions weren't being caught by readIface, so an error when
reading an interface could be unintentionally fatal (errors should be
soft when reading the old interface file for the current module).
Also, the Interrupted exception should not be caught by readIface,
because we want ^C to behave as normal when reading interface files
(currently it causes an interface-file read error rather than
interrupting the whole compiler).
Some exception-related compatibility functions have been moved from
Util to Panic.
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
--- $Id: DriverMkDepend.hs,v 1.22 2002/09/13 15:02:34 simonpj Exp $
+-- $Id: DriverMkDepend.hs,v 1.23 2002/09/18 10:51:01 simonmar Exp $
import Maybe ( isJust )
#if __GLASGOW_HASKELL__ <= 408
import Maybe ( isJust )
#if __GLASGOW_HASKELL__ <= 408
-import Util ( catchJust, ioErrors )
+import Panic ( catchJust, ioErrors )
#endif
-------------------------------------------------------------------------------
#endif
-------------------------------------------------------------------------------
#else
import System ( system )
#endif
#else
import System ( system )
#endif
-
--- Make catch work on older GHCs
-#if __GLASGOW_HASKELL__ > 408
-myCatch = Exception.catch
-#else
-myCatch = catchAllIO
-#endif
-
("Deleting: " ++ unwords fs)
(mapM_ rm fs)
where
("Deleting: " ++ unwords fs)
(mapM_ rm fs)
where
- rm f = removeFile f `myCatch`
+ rm f = removeFile f `catch`
(\_ignored ->
when (verb >= 2) $
hPutStrLn stderr ("Warning: deleting non-existent " ++ f)
(\_ignored ->
when (verb >= 2) $
hPutStrLn stderr ("Warning: deleting non-existent " ++ f)
; unless n $ do {
-- And run it!
; unless n $ do {
-- And run it!
- ; action `myCatch` handle_exn verb
+ ; action `catch` handle_exn verb
}}
where
handle_exn verb exn = do { when (verb >= 2) (hPutStr stderr "\n")
}}
where
handle_exn verb exn = do { when (verb >= 2) (hPutStr stderr "\n")
@readIface@ tries just the one file.
\begin{code}
@readIface@ tries just the one file.
\begin{code}
-readIface :: Module -> String -> IsBootInterface -> TcRn m (Either IOError ParsedIface)
+readIface :: Module -> String -> IsBootInterface -> TcRn m (Either Exception ParsedIface)
-- Nothing <=> file not found, or unreadable, or illegible
-- Just x <=> successfully found and parsed
readIface mod file_path is_hi_boot_file
-- Nothing <=> file not found, or unreadable, or illegible
-- Just x <=> successfully found and parsed
readIface mod file_path is_hi_boot_file
- = ioToTcRn_no_fail (read_iface mod file_path is_hi_boot_file)
+ = ioToTcRn (tryMost (read_iface mod file_path is_hi_boot_file))
read_iface mod file_path is_hi_boot_file
| is_hi_boot_file -- Read ascii
read_iface mod file_path is_hi_boot_file
| is_hi_boot_file -- Read ascii
thenM, thenM_, returnM, failM,
-- Non-standard operations
thenM, thenM_, returnM, failM,
-- Non-standard operations
- runTcRn, fixM, recoverM, ioToTcRn, ioToTcRn_no_fail,
+ runTcRn, fixM, recoverM, ioToTcRn,
newMutVar, readMutVar, writeMutVar,
getEnv, setEnv, updEnv, unsafeInterleaveM,
newMutVar, readMutVar, writeMutVar,
getEnv, setEnv, updEnv, unsafeInterleaveM,
ioToTcRn :: IO a -> TcRn m a
ioToTcRn io = TcRn (\ env -> io)
ioToTcRn :: IO a -> TcRn m a
ioToTcRn io = TcRn (\ env -> io)
-ioToTcRn_no_fail :: IO a -> TcRn m (Either IOError a)
--- Catch any IO error and embody it in the result
-ioToTcRn_no_fail io = TcRn (\ env -> catch (io >>= \r -> return (Right r))
- (\ exn -> return (Left exn)))
-
newMutVar :: a -> TcRn m (TcRef a)
newMutVar val = TcRn (\ env -> newIORef val)
newMutVar :: a -> TcRn m (TcRef a)
newMutVar val = TcRn (\ env -> newIORef val)
(
GhcException(..), ghcError, progName,
panic, panic#, assertPanic, trace,
(
GhcException(..), ghcError, progName,
panic, panic#, assertPanic, trace,
- showException, showGhcException, throwDyn
+ showException, showGhcException, throwDyn, tryMost,
+
+#if __GLASGOW_HASKELL__ <= 408
+ catchJust, ioErrors, throwTo,
+#endif
) where
#include "HsVersions.h"
) where
#include "HsVersions.h"
import FastTypes
import DYNAMIC
import FastTypes
import DYNAMIC
+import EXCEPTION as Exception
import TRACE ( trace )
import UNSAFE_IO ( unsafePerformIO )
import TRACE ( trace )
import UNSAFE_IO ( unsafePerformIO )
throw (AssertionFailed
("ASSERT failed! file " ++ file ++ ", line " ++ show line))
\end{code}
throw (AssertionFailed
("ASSERT failed! file " ++ file ++ ", line " ++ show line))
\end{code}
+
+\begin{code}
+-- | tryMost is like try, but passes through Interrupted and Panic
+-- exceptions. Used when we want soft failures when reading interface
+-- files, for example.
+
+tryMost :: IO a -> IO (Either Exception a)
+tryMost action = do r <- myTry action; filter r
+ where
+ filter (Left e@(DynException d))
+ | Just ghc_ex <- fromDynamic d
+ = case ghc_ex of
+ Interrupted -> throw e
+ Panic _ -> throw e
+ _other -> return (Left e)
+ filter other
+ = return other
+
+#if __GLASGOW_HASKELL__ <= 408
+myTry = tryAllIO
+#else
+myTry = Exception.try
+#endif
+\end{code}
+
+Compatibility stuff:
+
+\begin{code}
+#if __GLASGOW_HASKELL__ <= 408
+catchJust = catchIO
+ioErrors = justIoErrors
+throwTo = raiseInThread
+#endif
+\end{code}
-
-#if __GLASGOW_HASKELL__ <= 408
- catchJust, ioErrors, throwTo
-#endif
-
) where
#include "../includes/config.h"
) where
#include "../includes/config.h"
global :: a -> IORef a
global a = unsafePerformIO (newIORef a)
\end{code}
global :: a -> IORef a
global a = unsafePerformIO (newIORef a)
\end{code}
-
-Compatibility stuff:
-
-\begin{code}
-#if __GLASGOW_HASKELL__ <= 408
-catchJust = catchIO
-ioErrors = justIoErrors
-throwTo = raiseInThread
-#endif
-\end{code}