Re-add newlines to enable layout for multi-line input.

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

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index a5a1ba4..d119aac 100644 (file)
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -32,7 +32,7 @@ import Packages
 -- import PackageConfig
 import UniqFM
 
-import HscTypes ( implicitTyThings, handleFlagWarnings )
+import HscTypes ( handleFlagWarnings )
 import qualified RdrName ( getGRE_NameQualifier_maybes ) -- should this come via GHC?
 import Outputable       hiding (printForUser, printForUserPartWay)
 import Module           -- for ModuleEnv
@@ -399,7 +399,6 @@ runGHCi paths maybe_exprs = do
            -- can we assume this will always be the case?
            -- This would be a good place for runFileInputT.
            Right hdl -> runInputTWithPrefs defaultPrefs defaultSettings $ do
-                            setLogAction
                             runCommands $ fileLoop hdl
      where
       getDirectory f = case takeDirectory f of "" -> "."; d -> d
@@ -439,6 +438,8 @@ runGHCi paths maybe_exprs = do
             -- just evaluate the expression we were given
             enqueueCommands exprs
             let handle e = do st <- getGHCiState
+                              -- flush the interpreter's stdout/stderr on exit (#3890)
+                              flushInterpBuffers
                                    -- Jump through some hoops to get the
                                    -- current progname in the exception text:
                                    -- <progname>: <exception>
@@ -446,7 +447,6 @@ runGHCi paths maybe_exprs = do
                                    -- this used to be topHandlerFastExit, see #2228
                                  $ topHandler e
             runInputTWithPrefs defaultPrefs defaultSettings $ do
-                setLogAction
                 runCommands' handle (return Nothing)
 
   -- and finally, exit
@@ -458,9 +458,7 @@ runGHCiInput f = do
                         (return Nothing)
     let settings = setComplete ghciCompleteWord
                     $ defaultSettings {historyFile = histFile}
-    runInputT settings $ do
-        setLogAction
-        f
+    runInputT settings f
 
 nextInputLine :: Bool -> Bool -> InputT GHCi (Maybe String)
 nextInputLine show_prompt is_tty
@@ -574,9 +572,14 @@ runCommands = runCommands' handler
 runCommands' :: (SomeException -> GHCi Bool) -- Exception handler
              -> InputT GHCi (Maybe String) -> InputT GHCi ()
 runCommands' eh getCmd = do
-    b <- handleGhcException (\e -> case e of
-                    Interrupted -> return False
-                    _other -> liftIO (print e) >> return True)
+    b <- ghandle (\e -> case fromException e of
+                          Just UserInterrupt -> return False
+                          _ -> case fromException e of
+                                 Just ghc_e ->
+                                   do liftIO (print (ghc_e :: GhcException))
+                                      return True
+                                 _other ->
+                                   liftIO (Exception.throwIO e))
             (runOneCommand eh getCmd)
     if b then return () else runCommands' eh getCmd
 
@@ -619,7 +622,7 @@ runOneCommand eh getCmd = do
       maybe (liftIO (ioError collectError))
             (\l->if removeSpaces l == ":}" 
                  then return (Just $ removeSpaces c) 
-                 else collectCommand q (c++map normSpace l))
+                 else collectCommand q (c ++ "\n" ++ map normSpace l))
       where normSpace '\r' = ' '
             normSpace   c  = c
     -- QUESTION: is userError the one to use here?
@@ -826,9 +829,12 @@ info s  = handleSourceError GHC.printExceptionAndWarnings $ do
   -- constructor in the same type
 filterOutChildren :: (a -> TyThing) -> [a] -> [a]
 filterOutChildren get_thing xs 
-  = [x | x <- xs, not (getName (get_thing x) `elemNameSet` implicits)]
+  = filterOut has_parent xs
   where
-    implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)]
+    all_names = mkNameSet (map (getName . get_thing) xs)
+    has_parent x = case pprTyThingParent_maybe (get_thing x) of
+                     Just p  -> getName p `elemNameSet` all_names
+                     Nothing -> False
 
 pprInfo :: PrintExplicitForalls -> (TyThing, Fixity, [GHC.Instance]) -> SDoc
 pprInfo pefas (thing, fixity, insts)
@@ -1149,13 +1155,13 @@ typeOfExpr str
        ty <- GHC.exprType str
        dflags <- getDynFlags
        let pefas = dopt Opt_PrintExplicitForalls dflags
-       printForUser' $ sep [text str, nest 2 (dcolon <+> pprTypeForUser pefas ty)]
+       printForUser $ sep [text str, nest 2 (dcolon <+> pprTypeForUser pefas ty)]
 
 kindOfType :: String -> InputT GHCi ()
 kindOfType str 
   = handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do
        ty <- GHC.typeKind str
-       printForUser' $ text str <+> dcolon <+> ppr ty
+       printForUser $ text str <+> dcolon <+> ppr ty
 
 quit :: String -> InputT GHCi Bool
 quit _ = return True
@@ -1725,13 +1731,15 @@ handler exception = do
 showException :: SomeException -> GHCi ()
 showException se =
   io $ case fromException se of
-       Just Interrupted         -> putStrLn "Interrupted."
        -- omit the location for CmdLineError:
        Just (CmdLineError s)    -> putStrLn s
        -- ditto:
        Just ph@(PhaseFailed {}) -> putStrLn (showGhcException ph "")
        Just other_ghc_ex        -> print other_ghc_ex
-       Nothing                  -> putStrLn ("*** Exception: " ++ show se)
+       Nothing                  -> 
+         case fromException se of
+           Just UserInterrupt -> putStrLn "Interrupted."
+           _other             -> putStrLn ("*** Exception: " ++ show se)
 
 -----------------------------------------------------------------------------
 -- recursive exception handlers
@@ -2077,7 +2085,7 @@ listCmd "" = do
    mb_span <- lift getCurrentBreakSpan
    case mb_span of
       Nothing ->
-          printForUser' $ text "Not stopped at a breakpoint; nothing to list"
+          printForUser $ text "Not stopped at a breakpoint; nothing to list"
       Just span
        | GHC.isGoodSrcSpan span -> listAround span True
        | otherwise ->
@@ -2089,7 +2097,7 @@ listCmd "" = do
                                       [] -> text "rerunning with :trace,"
                                       _ -> empty
                             doWhat = traceIt <+> text ":back then :list"
-                        printForUser' (text "Unable to list source for" <+>
+                        printForUser (text "Unable to list source for" <+>
                                       ppr span
                                    $$ text "Try" <+> doWhat)
 listCmd str = list2 (words str)
@@ -2120,7 +2128,7 @@ list2 [arg] = do
                   noCanDo name $ text "can't find its location: " <>
                                  ppr loc
     where
-        noCanDo n why = printForUser' $
+        noCanDo n why = printForUser $
             text "cannot list source code for " <> ppr n <> text ": " <> why
 list2  _other = 
         outputStrLn "syntax:  :list [<line> | <module> <line> | <identifier>]"
@@ -2168,9 +2176,9 @@ listAround span do_highlight = do
   where
         file  = GHC.srcSpanFile span
         line1 = GHC.srcSpanStartLine span
-        col1  = GHC.srcSpanStartCol span
+        col1  = GHC.srcSpanStartCol span - 1
         line2 = GHC.srcSpanEndLine span
-        col2  = GHC.srcSpanEndCol span
+        col2  = GHC.srcSpanEndCol span - 1
 
         pad_before | line1 == 1 = 0
                    | otherwise  = 1