From: rrt <unknown>
Date: Fri, 29 Jun 2001 12:58:20 +0000 (+0000)
Subject: [project @ 2001-06-29 12:58:20 by rrt]
X-Git-Tag: Approximately_9120_patches~1653
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=045a18db20c0b7f2942e151dd8fa59dc9476d0bf;p=ghc-hetmet.git

[project @ 2001-06-29 12:58:20 by rrt]
Change the way that IO exceptions are handled and some associated details:

1. In the top-level exception handler, don't treat IO exceptions as a panic,
just print them out and stop.

2. In the slurping routines SysTools.copy and the fake cpp in
DriverPipeline, don't catch IO exceptions, just let them propagate.
---

diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index 52a6485..101471a 100644
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverPipeline.hs,v 1.84 2001/06/27 16:38:17 simonmar Exp $
+-- $Id: DriverPipeline.hs,v 1.85 2001/06/29 12:58:20 rrt Exp $
 --
 -- GHC Driver
 --
@@ -334,14 +334,13 @@ run_phase Cpp basename suff input_fn output_fn
 	-- ToDo: switch away from using 'echo' altogether (but need
 	-- a faster alternative than what's done below).
 #if defined(mingw32_TARGET_OS) && defined(MINIMAL_UNIX_DEPS)
-	  else (do
+	  else do
 	    h <- openFile output_fn WriteMode
 	    hPutStrLn h ("{-# LINE 1 \"" ++ input_fn ++ "\" #-}")
 	    ls <- readFile input_fn -- inefficient, but it'll do for now.
 	    			    -- ToDo: speed up via slurping.
 	    hPutStrLn h ls
-	    hClose h) `catchAllIO`
-	    	        (\_ -> throwDyn (PhaseFailed "Ineffective C pre-processor" (ExitFailure 1)))
+	    hClose h
 #else
 	  else do
 	    SysTools.runSomething "Ineffective C pre-processor"
diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index 30dffc3..c104285 100644
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS -fno-warn-incomplete-patterns #-}
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.76 2001/06/27 11:39:54 simonmar Exp $
+-- $Id: Main.hs,v 1.77 2001/06/29 12:58:20 rrt Exp $
 --
 -- GHC Driver program
 --
@@ -59,7 +59,7 @@ import Panic		( GhcException(..), panic )
 import IO
 import Directory	( doesFileExist )
 import IOExts		( readIORef, writeIORef )
-import Exception	( throwDyn, Exception(DynException) )
+import Exception	( throwDyn, Exception(..) )
 import System		( getArgs, exitWith, ExitCode(..) )
 import Monad
 import List
@@ -67,7 +67,7 @@ import Maybe
 
 #ifndef mingw32_TARGET_OS
 import Concurrent	( myThreadId )
-#ifdef __GLASGOW_HASKELL__ < 500
+#if __GLASGOW_HASKELL__ < 500
 import Exception        ( raiseInThread )
 #define throwTo  raiseInThread
 #else
@@ -111,9 +111,12 @@ import Dynamic		( toDyn )
 
 main =
   -- top-level exception handler: any unrecognised exception is a compiler bug.
-  handle (\exception -> do hPutStr stderr (show (Panic (show exception)))
-			   exitWith (ExitFailure 1)
-         ) $ do
+  handle (\exn -> case exn of
+	               IOException _ -> do hPutStr stderr (show exn)
+	                                   exitWith (ExitFailure 1)
+	               _             -> do hPutStr stderr (show (Panic (show exn)))
+	                                   exitWith (ExitFailure 1)
+	 ) $ do
 
   -- all error messages are propagated as exceptions
   handleDyn (\dyn -> case dyn of
diff --git a/ghc/compiler/main/SysTools.lhs b/ghc/compiler/main/SysTools.lhs
index d393d97..e2c43ff 100644
--- a/ghc/compiler/main/SysTools.lhs
+++ b/ghc/compiler/main/SysTools.lhs
@@ -406,13 +406,12 @@ touch purpose arg =  do p <- readIORef v_Pgm_T
 
 copy :: String -> String -> String -> IO ()
 copy purpose from to =
-    (do
+    do
       h <- openFile to WriteMode
       ls <- readFile from -- inefficient, but it'll do for now.
 	    		      -- ToDo: speed up via slurping.
       hPutStr h ls
-      hClose h) `catchAllIO`
-		 (\_ -> throwDyn (PhaseFailed purpose (ExitFailure 1)))
+      hClose h
 \end{code}
 
 \begin{code}