X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FMain.hs;h=bc18dae09ff3859470738bf1bf1d53f1016e95ca;hb=1c3d4480c8751665e71e344b71a844ca4191acc5;hp=048eee87fdc30a3419f91e82fbb143f2daeae779;hpb=3c22606bf3114747deeae0a8a1d5832ee834d9d1;p=ghc-hetmet.git diff --git a/compiler/main/Main.hs b/compiler/main/Main.hs index 048eee8..bc18dae 100644 --- a/compiler/main/Main.hs +++ b/compiler/main/Main.hs @@ -24,16 +24,16 @@ import HscMain ( newHscEnv ) import DriverPipeline ( oneShot, compileFile ) import DriverMkDepend ( doMkDependHS ) #ifdef GHCI -import InteractiveUI ( ghciWelcomeMsg, interactiveUI ) +import InteractiveUI ( interactiveUI, ghciWelcomeMsg ) #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 ) import StaticFlags -import DynFlags ( defaultDynFlags ) +import DynFlags import BasicTypes ( failed ) import ErrUtils ( putMsg ) import FastString ( getFastStringTable, isZEncoded, hasZEncoding ) @@ -70,7 +70,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 +85,15 @@ 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 + ShowVersion -> do showVersion + exitWith ExitSuccess + ShowNumVersion -> do putStrLn cProjectVersion + exitWith ExitSuccess + _ -> return () -- start our GHC session session <- GHC.newSession mbMinusB @@ -126,7 +130,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 @@ -154,18 +157,21 @@ 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 + 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 @@ -223,11 +229,15 @@ checkOptions cli_mode dflags srcs objs = do let unknown_opts = [ f | (f@('-':_), _) <- srcs ] when (notNull unknown_opts) (unknownFlagsErr unknown_opts) + when (notNull (filter isRTSWay (wayNames dflags)) + && isInterpretiveMode cli_mode) $ + putStrLn ("Warning: -debug, -threaded and -ticky are ignored by GHCi") + -- -prof and --interactive are not a good combination - when (notNull (filter (/= WayThreaded) (wayNames dflags)) + when (notNull (filter (not . isRTSWay) (wayNames dflags)) && isInterpretiveMode cli_mode) $ do throwDyn (UsageError - "--interactive can't be used with -prof, -ticky, or -unreg.") + "--interactive can't be used with -prof or -unreg.") -- -ohi sanity check if (isJust (outputHi dflags) && (isCompManagerMode cli_mode || srcs `lengthExceeds` 1)) @@ -286,17 +296,19 @@ 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 + | 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 @@ -351,6 +363,8 @@ mode_flags = , ( "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) @@ -424,24 +438,33 @@ doShowIface dflags file = do showBanner :: CmdLineMode -> DynFlags -> IO () showBanner cli_mode dflags = do let verb = verbosity dflags - -- Show the GHCi banner -# ifdef GHCI - when (isInteractiveMode cli_mode && verb >= 1) $ - hPutStrLn stdout ghciWelcomeMsg -# 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 + -- 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 " + hPutStr stderr cProjectVersion + hPutStr stderr ", for Haskell 98, stage " + hPutStr stderr cStage + 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 + showVersion :: IO () showVersion = do putStrLn (cProjectName ++ ", version " ++ cProjectVersion) @@ -449,8 +472,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