X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FMain.hs;h=f6e000216dddf96d600cc01b53876ebccd464905;hp=ec1d56945dcaca3d44755029c15090e78893bc74;hb=7fc749a43b4b6b85d234fa95d4928648259584f4;hpb=cedd4187afc6fabf7884a6dc42c3c47ea09624a3 diff --git a/compiler/main/Main.hs b/compiler/main/Main.hs index ec1d569..f6e0002 100644 --- a/compiler/main/Main.hs +++ b/compiler/main/Main.hs @@ -7,6 +7,13 @@ -- ----------------------------------------------------------------------------- +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module Main (main) where #include "HsVersions.h" @@ -24,7 +31,7 @@ import HscMain ( newHscEnv ) import DriverPipeline ( oneShot, compileFile ) import DriverMkDepend ( doMkDependHS ) #ifdef GHCI -import InteractiveUI ( interactiveUI ) +import InteractiveUI ( interactiveUI, ghciWelcomeMsg ) #endif -- Various other random stuff that we need @@ -33,7 +40,7 @@ import Packages ( dumpPackages ) import DriverPhases ( Phase(..), isSourceFilename, anyHsc, startPhase, isHaskellSrcFilename ) import StaticFlags -import DynFlags ( defaultDynFlags ) +import DynFlags import BasicTypes ( failed ) import ErrUtils ( putMsg ) import FastString ( getFastStringTable, isZEncoded, hasZEncoding ) @@ -70,7 +77,7 @@ main = argv0 <- getArgs let - (minusB_args, argv1) = partition (prefixMatch "-B") argv0 + (minusB_args, argv1) = partition ("-B" `isPrefixOf`) argv0 mbMinusB | null minusB_args = Nothing | otherwise = Just (drop 2 (last minusB_args)) @@ -85,11 +92,17 @@ main = -- to find out what version of GHC it's using before package.conf -- exists, so starting the session fails. case cli_mode of - ShowVersion -> do showVersion - exitWith ExitSuccess - ShowNumVersion -> do putStrLn cProjectVersion - exitWith ExitSuccess - _ -> return () + ShowInfo -> do showInfo + exitWith ExitSuccess + ShowSupportedLanguages -> do showSupportedLanguages + exitWith ExitSuccess + ShowDocDir -> do showDocDir + exitWith ExitSuccess + ShowVersion -> do showVersion + exitWith ExitSuccess + ShowNumVersion -> do putStrLn cProjectVersion + exitWith ExitSuccess + _ -> return () -- start our GHC session session <- GHC.newSession mbMinusB @@ -153,18 +166,22 @@ main = ---------------- Final sanity checking ----------- checkOptions cli_mode dflags srcs objs - ---------------- Do the business ----------- + ---------------- Do the business ----------- + let alreadyHandled = panic (show cli_mode ++ + " should already have been handled") case cli_mode of - ShowUsage -> showGhcUsage dflags cli_mode - PrintLibdir -> putStrLn (topDir dflags) - ShowVersion -> panic "ShowVersion should already have been handled" - ShowNumVersion -> panic "ShowNumVersion should already have been handled" - ShowInterface f -> doShowIface dflags f - DoMake -> doMake session srcs - DoMkDependHS -> doMkDependHS session (map fst srcs) - StopBefore p -> oneShot dflags p srcs - DoInteractive -> interactiveUI session srcs Nothing - DoEval expr -> interactiveUI session srcs (Just expr) + ShowUsage -> showGhcUsage dflags cli_mode + PrintLibdir -> putStrLn (topDir dflags) + ShowSupportedLanguages -> alreadyHandled + ShowDocDir -> alreadyHandled + ShowVersion -> alreadyHandled + ShowNumVersion -> alreadyHandled + ShowInterface f -> doShowIface dflags f + DoMake -> doMake session srcs + DoMkDependHS -> doMkDependHS session (map fst srcs) + StopBefore p -> oneShot dflags p srcs + DoInteractive -> interactiveUI session srcs Nothing + DoEval expr -> interactiveUI session srcs (Just expr) dumpFinalStats dflags exitWith ExitSuccess @@ -289,17 +306,20 @@ verifyOutputFiles dflags = do -- GHC modes of operation data CmdLineMode - = ShowUsage -- ghc -? - | PrintLibdir -- ghc --print-libdir - | ShowVersion -- ghc -V/--version - | ShowNumVersion -- ghc --numeric-version - | ShowInterface String -- ghc --show-iface - | DoMkDependHS -- ghc -M - | StopBefore Phase -- ghc -E | -C | -S - -- StopBefore StopLn is the default - | DoMake -- ghc --make - | DoInteractive -- ghc --interactive - | DoEval String -- ghc -e + = ShowUsage -- ghc -? + | PrintLibdir -- ghc --print-libdir + | ShowDocDir -- ghc --print-docdir + | ShowInfo -- ghc --info + | ShowSupportedLanguages -- ghc --supported-languages + | ShowVersion -- ghc -V/--version + | ShowNumVersion -- ghc --numeric-version + | ShowInterface String -- ghc --show-iface + | DoMkDependHS -- ghc -M + | StopBefore Phase -- ghc -E | -C | -S + -- StopBefore StopLn is the default + | DoMake -- ghc --make + | DoInteractive -- ghc --interactive + | DoEval String -- ghc -e deriving (Show) isInteractiveMode, isInterpretiveMode :: CmdLineMode -> Bool @@ -348,12 +368,15 @@ type ModeM a = CmdLineP (CmdLineMode, String, [String]) a mode_flags :: [(String, OptKind (CmdLineP (CmdLineMode, String, [String])))] mode_flags = [ ------- help / version ---------------------------------------------- - ( "?" , PassFlag (setMode ShowUsage)) - , ( "-help" , PassFlag (setMode ShowUsage)) - , ( "-print-libdir" , PassFlag (setMode PrintLibdir)) - , ( "V" , PassFlag (setMode ShowVersion)) - , ( "-version" , PassFlag (setMode ShowVersion)) - , ( "-numeric-version", PassFlag (setMode ShowNumVersion)) + ( "?" , PassFlag (setMode ShowUsage)) + , ( "-help" , PassFlag (setMode ShowUsage)) + , ( "-print-libdir" , PassFlag (setMode PrintLibdir)) + , ( "-print-docdir" , PassFlag (setMode ShowDocDir)) + , ( "V" , PassFlag (setMode ShowVersion)) + , ( "-version" , PassFlag (setMode ShowVersion)) + , ( "-numeric-version" , PassFlag (setMode ShowNumVersion)) + , ( "-info" , PassFlag (setMode ShowInfo)) + , ( "-supported-languages", PassFlag (setMode ShowSupportedLanguages)) ------- interfaces ---------------------------------------------------- , ( "-show-iface" , HasArg (\f -> setMode (ShowInterface f) @@ -428,6 +451,11 @@ showBanner :: CmdLineMode -> DynFlags -> IO () showBanner cli_mode dflags = do let verb = verbosity dflags +#ifdef GHCI + -- Show the GHCi banner + when (isInteractiveMode cli_mode && verb >= 1) $ putStrLn ghciWelcomeMsg +#endif + -- Display details of the configuration in verbose mode when (verb >= 2) $ do hPutStr stderr "Glasgow Haskell Compiler, Version " @@ -437,6 +465,23 @@ showBanner cli_mode dflags = do hPutStr stderr " booted by GHC version " hPutStrLn stderr cBooterVersion +-- We print out a Read-friendly string, but a prettier one than the +-- Show instance gives us +showInfo :: IO () +showInfo = do + let sq x = " [" ++ x ++ "\n ]" + putStrLn $ sq $ concat $ intersperse "\n ," $ map show compilerInfo + exitWith ExitSuccess + +showSupportedLanguages :: IO () +showSupportedLanguages = do mapM_ putStrLn supportedLanguages + exitWith ExitSuccess + +showDocDir :: IO () +showDocDir = do + putStrLn cDocDir + exitWith ExitSuccess + showVersion :: IO () showVersion = do putStrLn (cProjectName ++ ", version " ++ cProjectVersion) @@ -444,8 +489,8 @@ showVersion = do showGhcUsage dflags cli_mode = do let usage_path - | DoInteractive <- cli_mode = ghcUsagePath dflags - | otherwise = ghciUsagePath dflags + | DoInteractive <- cli_mode = ghciUsagePath dflags + | otherwise = ghcUsagePath dflags usage <- readFile usage_path dump usage exitWith ExitSuccess