From: simonmar <unknown>
Date: Fri, 15 Jun 2001 11:40:29 +0000 (+0000)
Subject: [project @ 2001-06-15 11:40:29 by simonmar]
X-Git-Tag: Approximately_9120_patches~1752
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=77435152125d6fc8e0be97d69827299e6607d225;p=ghc-hetmet.git

[project @ 2001-06-15 11:40:29 by simonmar]
import Packages
---

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 2ac225a..bfbcb75 100644
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.75 2001/06/15 08:29:57 simonpj Exp $
+-- $Id: InteractiveUI.hs,v 1.76 2001/06/15 11:40:29 simonmar Exp $
 --
 -- GHC Interactive User Interface
 --
@@ -13,6 +13,7 @@ module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where
 #include "../includes/config.h"
 #include "HsVersions.h"
 
+import Packages
 import CompManager
 import HscTypes		( GhciMode(..) )
 import ByteCodeLink
@@ -267,27 +268,28 @@ readlineLoop = do
 -- and carries on.
 runCommand :: String -> GHCi Bool
 runCommand c = 
-  ghciHandle ( \exception -> 
-	(case exception of
-	   DynException dyn -> 
-	      case fromDynamic dyn of
-		Nothing -> io (putStrLn ("*** Exception: (unknown)"))
-		Just ghc_ex -> 
-		  case ghc_ex of
-		    PhaseFailed phase code ->
-			io ( putStrLn ("Phase " ++ phase ++ " failed (code "
-				        ++ show code ++ ")"))
-		    Interrupted -> io (putStrLn "Interrupted.")
-			-- omit the location for CmdLineError
-		    CmdLineError s -> io (putStrLn s)
-		    other -> io (putStrLn (show (ghc_ex :: GhcException)))
-
-	   other -> io (putStrLn ("*** Exception: " ++ show exception))
-
-	) >> return False
-     ) $
-
-   doCommand c
+  ghciHandle ( \exception -> do
+		flushEverything
+		showException exception
+		return False
+	     ) $
+  doCommand c
+
+showException (DynException dyn) =
+  case fromDynamic dyn of
+    Nothing -> 
+	io (putStrLn ("*** Exception: (unknown)"))
+    Just (PhaseFailed phase code) ->
+	io (putStrLn ("Phase " ++ phase ++ " failed (code "
+		       ++ show code ++ ")"))
+    Just Interrupted ->
+	io (putStrLn "Interrupted.")
+    Just (CmdLineError s) -> 
+	io (putStrLn s)	 -- omit the location for CmdLineError
+    Just other_ghc_ex ->
+	io (putStrLn (show other_ghc_ex))
+showException other_exception
+  = io (putStrLn ("*** Exception: " ++ show other_exception))
 
 doCommand (':' : command) = specialCommand command
 doCommand stmt