Tweak banner printing

* -{short,long}-ghci-banner are now dynamic options, so you can put
  ":set -short-ghci-banner" in .ghci
* The -v2 banner information now always tells you what compiler booted GHC,
  and what stage the compiler is. Thus we no longer assume that stage > 1
  iff GHCI is defined.

diff --git a/compiler/Makefile b/compiler/Makefile
index a48e0d8..4db30aa 100644 (file)
--- a/compiler/Makefile
+++ b/compiler/Makefile
@@ -214,6 +214,7 @@ $(CONFIG_HS) : $(FPTOOLS_TOP)/mk/config.mk Makefile
        @echo "cProjectVersionInt    = \"$(ProjectVersionInt)\"" >> $(CONFIG_HS)
        @echo "cProjectPatchLevel    = \"$(ProjectPatchLevel)\"" >> $(CONFIG_HS)
        @echo "cBooterVersion        = \"$(GhcVersion)\"" >> $(CONFIG_HS)
+       @echo "cStage                = STAGE" >> $(CONFIG_HS)
        @echo "cHscIfaceFileVersion  = \"$(HscIfaceFileVersion)\"" >> $(CONFIG_HS)
        @echo "cGhcWithNativeCodeGen = \"$(GhcWithNativeCodeGen)\"" >> $(CONFIG_HS)
        @echo "cGhcUnregisterised    = \"$(GhcUnregisterised)\"" >> $(CONFIG_HS)
@@ -963,6 +964,8 @@ TAGS_HS_SRCS = parser/Parser.y.pp $(filter-out $(DERIVED_SRCS) main/Config.hs pa
 
 include $(TOP)/mk/target.mk
 
+$(odir)/main/Config.$(way_)o: SRC_HC_OPTS+=-DSTAGE='"$(stage)"'
+
 # -----------------------------------------------------------------------------
 # Explicit dependencies
 

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 2497bad..0fd8b4e 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -6,11 +6,7 @@
 -- (c) The GHC Team 2005-2006
 --
 -----------------------------------------------------------------------------
-module InteractiveUI ( 
-       interactiveUI,
-       ghciWelcomeMsg,
-       ghciShortWelcomeMsg
-   ) where
+module InteractiveUI ( interactiveUI ) where
 
 #include "HsVersions.h"
 
@@ -246,21 +242,22 @@ interactiveUI session srcs maybe_expr = do
    newStablePtr stdout
    newStablePtr stderr
 
-       -- Initialise buffering for the *interpreted* I/O system
+    -- Initialise buffering for the *interpreted* I/O system
    initInterpBuffering session
 
    when (isNothing maybe_expr) $ do
-       -- Only for GHCi (not runghc and ghc -e):
-       -- Turn buffering off for the compiled program's stdout/stderr
-       turnOffBuffering
-       -- Turn buffering off for GHCi's stdout
-       hFlush stdout
-       hSetBuffering stdout NoBuffering
-       -- We don't want the cmd line to buffer any input that might be
-       -- intended for the program, so unbuffer stdin.
-       hSetBuffering stdin NoBuffering
-
-       -- initial context is just the Prelude
+        -- Only for GHCi (not runghc and ghc -e):
+
+        -- Turn buffering off for the compiled program's stdout/stderr
+        turnOffBuffering
+        -- Turn buffering off for GHCi's stdout
+        hFlush stdout
+        hSetBuffering stdout NoBuffering
+        -- We don't want the cmd line to buffer any input that might be
+        -- intended for the program, so unbuffer stdin.
+        hSetBuffering stdin NoBuffering
+
+        -- initial context is just the Prelude
    prel_mod <- GHC.findModule session prel_name (Just basePackageId)
    GHC.setContext session [] [prel_mod]
 
@@ -352,28 +349,33 @@ runGHCi paths maybe_expr = do
   let show_prompt = verbosity dflags > 0 || is_tty
 
   case maybe_expr of
-       Nothing -> 
+        Nothing ->
           do
 #if defined(mingw32_HOST_OS)
-            -- The win32 Console API mutates the first character of 
+            -- 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 ()
+            case flushed of
+             Left err | isDoesNotExistError err -> return ()
+                      | otherwise -> io (ioError err)
+             Right () -> return ()
 #endif
-           -- initialise the console if necessary
-           io setUpConsole
-
-           -- enter the interactive loop
-           interactiveLoop is_tty show_prompt
-       Just expr -> do
-           -- just evaluate the expression we were given
-           runCommandEval expr
-           return ()
+            -- initialise the console if necessary
+            io setUpConsole
+
+            let msg = if dopt Opt_ShortGhciBanner dflags
+                      then ghciShortWelcomeMsg
+                      else ghciWelcomeMsg
+            when (verbosity dflags >= 1) $ io $ putStrLn msg
+
+            -- enter the interactive loop
+            interactiveLoop is_tty show_prompt
+        Just expr -> do
+            -- just evaluate the expression we were given
+            runCommandEval expr
+            return ()
 
   -- and finally, exit
   io $ do when (verbosity dflags > 0) $ putStrLn "Leaving GHCi."

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 1b39d5d..c8615da 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -196,6 +196,7 @@ data DynFlag
    | Opt_RewriteRules
 
    -- misc opts
+   | Opt_ShortGhciBanner
    | Opt_Cpp
    | Opt_Pp
    | Opt_ForceRecomp
@@ -836,6 +837,8 @@ dynamic_flags = [
   ,  ( "F"             , NoArg  (setDynFlag Opt_Pp))
   ,  ( "#include"      , HasArg (addCmdlineHCInclude) )
   ,  ( "v"             , OptIntSuffix setVerbosity )
+  ,  ( "short-ghci-banner", NoArg (setDynFlag Opt_ShortGhciBanner) )
+  ,  ( "long-ghci-banner" , NoArg (unSetDynFlag Opt_ShortGhciBanner) )
 
         ------- Specific phases  --------------------------------------------
   ,  ( "pgmL"           , HasArg (upd . setPgmL) )  

diff --git a/compiler/main/Main.hs b/compiler/main/Main.hs
index 2b17310..ec1d569 100644 (file)
--- a/compiler/main/Main.hs
+++ b/compiler/main/Main.hs
@@ -24,11 +24,11 @@ import HscMain          ( newHscEnv )
 import DriverPipeline  ( oneShot, compileFile )
 import DriverMkDepend  ( doMkDependHS )
 #ifdef GHCI
-import InteractiveUI   ( ghciWelcomeMsg, ghciShortWelcomeMsg, interactiveUI )
+import InteractiveUI   ( interactiveUI )
 #endif
 
 -- Various other random stuff that we need
-import Config          ( cProjectVersion, cBooterVersion, cProjectName )
+import Config
 import Packages                ( dumpPackages )
 import DriverPhases    ( Phase(..), isSourceFilename, anyHsc,
                          startPhase, isHaskellSrcFilename )
@@ -126,7 +126,6 @@ main =
        -- make sure we clean up after ourselves
   GHC.defaultCleanupHandler dflags $ do
 
-       -- Display banner
   showBanner cli_mode dflags
 
   -- we've finished manipulating the DynFlags, update the session
@@ -428,25 +427,15 @@ doShowIface dflags file = do
 showBanner :: CmdLineMode -> DynFlags -> IO ()
 showBanner cli_mode dflags = do
    let verb = verbosity dflags
-       -- Show the GHCi banner
-#  ifdef GHCI
-   let msg = if opt_ShortGhciBanner
-             then ghciShortWelcomeMsg
-             else ghciWelcomeMsg
-   when (isInteractiveMode cli_mode && verb >= 1) $ hPutStrLn stdout msg
-#  endif
-
-       -- Display details of the configuration in verbose mode
-   when (not (isInteractiveMode cli_mode) && verb >= 2) $
-       do hPutStr stderr "Glasgow Haskell Compiler, Version "
-          hPutStr stderr cProjectVersion
-          hPutStr stderr ", for Haskell 98, compiled by GHC version "
-#ifdef GHCI
-          -- GHCI is only set when we are bootstrapping...
-          hPutStrLn stderr cProjectVersion
-#else
-          hPutStrLn stderr cBooterVersion
-#endif
+
+   -- Display details of the configuration in verbose mode
+   when (verb >= 2) $
+    do hPutStr stderr "Glasgow Haskell Compiler, Version "
+       hPutStr stderr cProjectVersion
+       hPutStr stderr ", for Haskell 98, stage "
+       hPutStr stderr cStage
+       hPutStr stderr " booted by GHC version "
+       hPutStrLn stderr cBooterVersion
 
 showVersion :: IO ()
 showVersion = do

diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index 06a47b5..0d17af2 100644 (file)
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -61,7 +61,6 @@ module StaticFlags (
 
        -- misc opts
        opt_IgnoreDotGhci,
-       opt_ShortGhciBanner,
        opt_ErrorSpans,
        opt_GranMacros,
        opt_HiVersion,
@@ -144,8 +143,6 @@ static_flags = [
        ------- GHCi -------------------------------------------------------
      ( "ignore-dot-ghci", PassFlag addOpt )
   ,  ( "read-dot-ghci"  , NoArg (removeOpt "-ignore-dot-ghci") )
-  ,  ( "short-ghci-banner", PassFlag addOpt )
-  ,  ( "long-ghci-banner" , NoArg (removeOpt "-short-ghci-banner") )
 
        ------- ways --------------------------------------------------------
   ,  ( "prof"          , NoArg (addWay WayProf) )
@@ -276,7 +273,6 @@ unpacked_opts =
 
 
 opt_IgnoreDotGhci              = lookUp FSLIT("-ignore-dot-ghci")
-opt_ShortGhciBanner             = lookUp FSLIT("-short-ghci-banner")
 
 -- debugging opts
 opt_PprStyle_Debug             = lookUp  FSLIT("-dppr-debug")

diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index 0ff729b..d0b0169 100644 (file)
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -484,13 +484,13 @@
            <row>
              <entry><option>-short-ghci-banner</option></entry>
              <entry>Display a one-line banner at GHCi startup</entry>
-             <entry>static</entry>
+             <entry>dynamic</entry>
              <entry>-</entry>
            </row>
            <row>
              <entry><option>-long-ghci-banner</option></entry>
              <entry>Display a full banner at GHCi startup</entry>
-             <entry>static</entry>
+             <entry>dynamic</entry>
              <entry>-</entry>
            </row>
            <row>