X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FMain.hs;h=964b48804de93b4508b80eb7c66056c46e8a573e;hp=971eb3500c303e296f48b2d6d8b9eb9882a175af;hb=4d401b9d0514c93efc296ac99f0e89e4514996b7;hpb=ee565d464248078a4f2d46f98667aa4fcdc56db4 diff --git a/compiler/main/Main.hs b/compiler/main/Main.hs index 971eb35..964b488 100644 --- a/compiler/main/Main.hs +++ b/compiler/main/Main.hs @@ -13,40 +13,43 @@ module Main (main) where -- The official GHC API import qualified GHC -import GHC ( Session, DynFlags(..), GhcMode(..), HscTarget(..), +import GHC ( Session, DynFlags(..), HscTarget(..), + GhcMode(..), GhcLink(..), LoadHowMuch(..), dopt, DynFlag(..) ) import CmdLineParser -- Implementations of the various modes (--show-iface, mkdependHS. etc.) -import MkIface ( showIface ) +import LoadIface ( showIface ) +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 Packages ( dumpPackages, initPackages ) +import Config +import Packages ( dumpPackages ) import DriverPhases ( Phase(..), isSourceFilename, anyHsc, startPhase, isHaskellSrcFilename ) -import StaticFlags ( staticFlags, v_Ld_inputs, parseStaticFlags ) +import StaticFlags import DynFlags ( defaultDynFlags ) import BasicTypes ( failed ) -import ErrUtils ( Message, debugTraceMsg, putMsg ) +import ErrUtils ( putMsg ) import FastString ( getFastStringTable, isZEncoded, hasZEncoding ) import Outputable import Util import Panic -- Standard Haskell libraries -import EXCEPTION ( throwDyn ) -import IO -import Directory ( doesDirectoryExist ) -import System ( getArgs, exitWith, ExitCode(..) ) -import Monad -import List -import Maybe +import Control.Exception ( throwDyn ) +import System.IO +import System.Directory ( doesDirectoryExist ) +import System.Environment +import System.Exit +import Control.Monad +import Data.List +import Data.Maybe ----------------------------------------------------------------------------- -- ToDo: @@ -67,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)) @@ -76,29 +79,39 @@ main = -- 2. Parse the "mode" flags (--make, --interactive etc.) (cli_mode, argv3) <- parseModeFlags argv2 - let mode = case cli_mode of - DoInteractive -> Interactive - DoEval _ -> Interactive - DoMake -> BatchCompile - DoMkDependHS -> MkDepend - _ -> OneShot + -- If all we want to do is to show the version number then do it + -- now, before we start a GHC session etc. + -- If we do it later then bootstrapping gets confused as it tries + -- 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 () -- start our GHC session - session <- GHC.newSession mode mbMinusB + session <- GHC.newSession mbMinusB dflags0 <- GHC.getSessionDynFlags session - -- set the default HscTarget. The HscTarget can be further - -- adjusted on a module by module basis, using only the -fvia-C and - -- -fasm flags. If the default HscTarget is not HscC or HscAsm, - -- -fvia-C and -fasm have no effect. - let lang = case cli_mode of - DoInteractive -> HscInterpreted - DoEval _ -> HscInterpreted - _other -> hscTarget dflags0 - - let dflags1 = dflags0{ ghcMode = mode, - hscTarget = lang, + -- set the default GhcMode, HscTarget and GhcLink. The HscTarget + -- can be further adjusted on a module by module basis, using only + -- the -fvia-C and -fasm flags. If the default HscTarget is not + -- HscC or HscAsm, -fvia-C and -fasm have no effect. + let dflt_target = hscTarget dflags0 + (mode, lang, link) + = case cli_mode of + DoInteractive -> (CompManager, HscInterpreted, LinkInMemory) + DoEval _ -> (CompManager, HscInterpreted, LinkInMemory) + DoMake -> (CompManager, dflt_target, LinkBinary) + DoMkDependHS -> (MkDepend, dflt_target, LinkBinary) + _ -> (OneShot, dflt_target, LinkBinary) + + let dflags1 = dflags0{ ghcMode = mode, + hscTarget = lang, + ghcLink = link, -- leave out hscOutName for now hscOutName = panic "Main.main:hscOutName not set", verbosity = case cli_mode of @@ -113,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 @@ -143,16 +155,16 @@ main = ---------------- Do the business ----------- case cli_mode of - ShowUsage -> showGhcUsage dflags cli_mode - PrintLibdir -> putStrLn (topDir dflags) - ShowVersion -> showVersion - ShowNumVersion -> putStrLn cProjectVersion - ShowInterface f -> showIface 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) + 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) dumpFinalStats dflags exitWith ExitSuccess @@ -210,10 +222,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 (wayNames dflags) && isInterpretiveMode cli_mode) $ + when (notNull (filter (not . isRTSWay) (wayNames dflags)) + && isInterpretiveMode cli_mode) $ do throwDyn (UsageError - "--interactive can't be used with -prof, -ticky, -unreg or -smp.") + "--interactive can't be used with -prof or -unreg.") -- -ohi sanity check if (isJust (outputHi dflags) && (isCompManagerMode cli_mode || srcs `lengthExceeds` 1)) @@ -272,17 +289,17 @@ 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 + | 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 @@ -395,30 +412,36 @@ doMake sess srcs = do when (failed ok_flag) (exitWith (ExitFailure 1)) return () + +-- --------------------------------------------------------------------------- +-- --show-iface mode + +doShowIface :: DynFlags -> FilePath -> IO () +doShowIface dflags file = do + hsc_env <- newHscEnv dflags + showIface hsc_env file + -- --------------------------------------------------------------------------- -- Various banners and verbosity output. 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 + showVersion :: IO () showVersion = do putStrLn (cProjectName ++ ", version " ++ cProjectVersion) @@ -426,8 +449,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