From cedd4187afc6fabf7884a6dc42c3c47ea09624a3 Mon Sep 17 00:00:00 2001
From: Ian Lynagh <igloo@earth.li>
Date: Tue, 12 Jun 2007 21:07:38 +0000
Subject: [PATCH] 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.
---
compiler/Makefile | 3 ++
compiler/ghci/InteractiveUI.hs | 66 +++++++++++++++++-----------------
compiler/main/DynFlags.hs | 3 ++
compiler/main/Main.hs | 33 ++++++-----------
compiler/main/StaticFlags.hs | 4 ---
docs/users_guide/flags.xml | 4 +--
6 files changed, 53 insertions(+), 60 deletions(-)
diff --git a/compiler/Makefile b/compiler/Makefile
index a48e0d8c513..4db30aa9319 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 2497bada366..0fd8b4e08de 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 1b39d5ded40..c8615da615a 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 2b173104fb2..ec1d56945dc 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 06a47b5a653..0d17af2dcbe 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 0ff729b2b6f..d0b01691a7f 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>
--
GitLab