[project @ 2005-10-25 12:48:35 by simonmar]

[ghc-hetmet.git] / ghc / compiler / ghci / InteractiveUI.hs

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index 5eeb1a3..3469421 100644 (file)
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -37,7 +37,6 @@ import StaticFlags    ( opt_IgnoreDotGhci )
 import Linker          ( showLinkerState )
 import Util            ( removeSpaces, handle, global, toArgs,
                          looksLikeModuleName, prefixMatch, sortLe )
-import ErrUtils                ( printErrorsAndWarnings )
 
 #ifndef mingw32_HOST_OS
 import System.Posix
@@ -196,13 +195,6 @@ interactiveUI session srcs maybe_expr = do
    Readline.initialize
 #endif
 
-#if defined(mingw32_HOST_OS)
-    -- The win32 Console API mutates the first character of 
-    -- type-ahead when reading from it in a non-buffered manner. Work
-    -- around this by flushing the input buffer of type-ahead characters.
-    -- 
-   GHC.ConsoleHandler.flushConsole stdin
-#endif
    startGHCi (runGHCi srcs maybe_expr)
        GHCiState{ progname = "<interactive>",
                   args = [],
@@ -265,6 +257,18 @@ runGHCi paths maybe_expr = do
 
   case maybe_expr of
        Nothing -> 
+#if defined(mingw32_HOST_OS)
+          do
+            -- The win32 Console API mutates the first character of 
+            -- type-ahead when reading from it in a non-buffered manner. Work
+            -- around this by flushing the input buffer of type-ahead characters,
+            -- but only if stdin is available.
+            flushed <- io (IO.try (GHC.ConsoleHandler.flushConsole stdin))
+            case flushed of 
+            Left err | isDoesNotExistError err -> return ()
+                     | otherwise -> io (ioError err)
+            Right () -> return ()
+#endif
            -- enter the interactive loop
            interactiveLoop is_tty show_prompt
        Just expr -> do
@@ -384,6 +388,11 @@ readlineLoop = do
 
 runCommand :: String -> GHCi Bool
 runCommand c = ghciHandle handler (doCommand c)
+  where 
+    doCommand (':' : command) = specialCommand command
+    doCommand stmt
+       = do timeIt (do nms <- runStmt stmt; finishEvalExpr nms)
+            return False
 
 -- This version is for the GHC command-line option -e.  The only difference
 -- from runCommand is that it catches the ExitException exception and
@@ -394,6 +403,14 @@ runCommandEval c = ghciHandle handleEval (doCommand c)
     handleEval e                    = do showException e
                                         io (exitWith (ExitFailure 1))
 
+    doCommand (':' : command) = specialCommand command
+    doCommand stmt
+       = do nms <- runStmt stmt
+           case nms of 
+               Nothing -> io (exitWith (ExitFailure 1))
+                 -- failure to run the command causes exit(1) for ghc -e.
+               _       -> finishEvalExpr nms
+
 -- This is the exception handler for exceptions generated by the
 -- user's code; it normally just prints out the exception.  The
 -- handler must be recursive, in case showing the exception causes
@@ -420,29 +437,26 @@ showException (DynException dyn) =
 showException other_exception
   = io (putStrLn ("*** Exception: " ++ show other_exception))
 
-doCommand (':' : command) = specialCommand command
-doCommand stmt
-   = do timeIt (do nms <- runStmt stmt; finishEvalExpr nms)
-        return False
-
-runStmt :: String -> GHCi [Name]
+runStmt :: String -> GHCi (Maybe [Name])
 runStmt stmt
- | null (filter (not.isSpace) stmt) = return []
+ | null (filter (not.isSpace) stmt) = return (Just [])
  | otherwise
  = do st <- getGHCiState
       session <- getSession
       result <- io $ withProgName (progname st) $ withArgs (args st) $
                     GHC.runStmt session stmt
       case result of
-       GHC.RunFailed      -> return []
+       GHC.RunFailed      -> return Nothing
        GHC.RunException e -> throw e  -- this is caught by runCommand(Eval)
-       GHC.RunOk names    -> return names
+       GHC.RunOk names    -> return (Just names)
 
 -- possibly print the type and revert CAFs after evaluating an expression
-finishEvalExpr names
+finishEvalExpr mb_names
  = do b <- isOptionSet ShowType
       session <- getSession
-      when b (mapM_ (showTypeOfName session) names)
+      case mb_names of
+       Nothing    -> return ()      
+       Just names -> when b (mapM_ (showTypeOfName session) names)
 
       flushInterpBuffers
       io installSignalHandlers
@@ -660,7 +674,7 @@ checkModule :: String -> GHCi ()
 checkModule m = do
   let modl = mkModule m
   session <- getSession
-  result <- io (GHC.checkModule session modl printErrorsAndWarnings)
+  result <- io (GHC.checkModule session modl)
   case result of
     Nothing -> io $ putStrLn "Nothing"
     Just r  -> io $ putStrLn (showSDoc (