From cedd4187afc6fabf7884a6dc42c3c47ea09624a3 Mon Sep 17 00:00:00 2001 From: Ian Lynagh 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 a48e0d8..4db30aa 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 2497bad..0fd8b4e 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 1b39d5d..c8615da 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 2b17310..ec1d569 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 06a47b5..0d17af2 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 0ff729b..d0b0169 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -484,13 +484,13 @@ Display a one-line banner at GHCi startup - static + dynamic - Display a full banner at GHCi startup - static + dynamic - -- 1.7.10.4