[project @ 2002-09-18 10:51:01 by simonmar]

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.

diff --git a/ghc/compiler/main/DriverMkDepend.hs b/ghc/compiler/main/DriverMkDepend.hs
index e4d10db..607ba78 100644 (file)
--- a/ghc/compiler/main/DriverMkDepend.hs
+++ b/ghc/compiler/main/DriverMkDepend.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $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 $
 --
 -- GHC Driver
 --
@@ -31,7 +31,7 @@ import Monad            ( when )
 import Maybe            ( isJust )
 
 #if __GLASGOW_HASKELL__ <= 408
-import Util            ( catchJust, ioErrors )
+import Panic           ( catchJust, ioErrors )
 #endif
 
 -------------------------------------------------------------------------------

diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs
index facf3fc..a6f7bf9 100644 (file)
--- a/ghc/compiler/main/SysTools.lhs
+++ b/ghc/compiler/main/SysTools.lhs
@@ -115,14 +115,6 @@ import SystemExts       ( rawSystem )
 #else
 import System          ( system )
 #endif
-
--- Make catch work on older GHCs
-#if __GLASGOW_HASKELL__ > 408
-myCatch = Exception.catch
-#else
-myCatch = catchAllIO
-#endif
-
 \end{code}
 
 
@@ -675,7 +667,7 @@ removeTmpFiles verb fs
             ("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)
@@ -737,7 +729,7 @@ traceCmd phase_name cmd_line action
        ; 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")

diff --git a/ghc/compiler/rename/RnHiFiles.lhs b/ghc/compiler/rename/RnHiFiles.lhs
index 931c5cf..76f636c 100644 (file)
--- a/ghc/compiler/rename/RnHiFiles.lhs
+++ b/ghc/compiler/rename/RnHiFiles.lhs
@@ -688,12 +688,12 @@ findHiFile mod_name hi_boot_file
 @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
-  = 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

diff --git a/ghc/compiler/typecheck/TcRnTypes.lhs b/ghc/compiler/typecheck/TcRnTypes.lhs
index 8babf69..0b3cbda 100644 (file)
--- a/ghc/compiler/typecheck/TcRnTypes.lhs
+++ b/ghc/compiler/typecheck/TcRnTypes.lhs
@@ -9,7 +9,7 @@ module TcRnTypes(
        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, 
                
@@ -173,11 +173,6 @@ Performing arbitrary I/O, plus the read/write var (for efficiency)
 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)
 

diff --git a/ghc/compiler/utils/Panic.lhs b/ghc/compiler/utils/Panic.lhs
index 1f677fc..c449997 100644 (file)
--- a/ghc/compiler/utils/Panic.lhs
+++ b/ghc/compiler/utils/Panic.lhs
@@ -13,7 +13,11 @@ module Panic
    ( 
      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"
@@ -22,7 +26,7 @@ import Config
 import FastTypes
 
 import DYNAMIC
-import EXCEPTION
+import EXCEPTION as Exception
 import TRACE           ( trace )
 import UNSAFE_IO       ( unsafePerformIO )
 
@@ -121,3 +125,37 @@ assertPanic file line =
   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}

diff --git a/ghc/compiler/utils/Util.lhs b/ghc/compiler/utils/Util.lhs
index d7b228e..119ae82 100644 (file)
--- a/ghc/compiler/utils/Util.lhs
+++ b/ghc/compiler/utils/Util.lhs
@@ -44,11 +44,6 @@ module Util (
        unzipWith,
 
        global,
-
-#if __GLASGOW_HASKELL__ <= 408
-       catchJust, ioErrors, throwTo
-#endif
-
     ) where
 
 #include "../includes/config.h"
@@ -787,13 +782,3 @@ Global variables:
 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}