Tweak banner printing2007-06-12

* -{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.

6 files changed, 53 insertions, 60 deletions

diff --git a/compiler/Makefile b/compiler/Makefile
index a48e0d8c51..4db30aa931 100644
--- 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 2497bada36..0fd8b4e08d 100644
--- 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 1b39d5ded4..c8615da615 100644
--- 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 2b173104fb..ec1d56945d 100644
--- 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 06a47b5a65..0d17af2dcb 100644
--- 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 0ff729b2b6..d0b01691a7 100644
--- 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>