X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FMain.hs;h=048eee87fdc30a3419f91e82fbb143f2daeae779;hp=55234e7636d556aed15a8fe81d944793e9993295;hb=3c22606bf3114747deeae0a8a1d5832ee834d9d1;hpb=b00b5bc04ff36a551552470060064f0b7d84ca30 diff --git a/compiler/main/Main.hs b/compiler/main/Main.hs index 55234e7..048eee8 100644 --- a/compiler/main/Main.hs +++ b/compiler/main/Main.hs @@ -13,7 +13,8 @@ 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 @@ -31,7 +32,7 @@ import Config ( cProjectVersion, cBooterVersion, cProjectName ) 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 ( putMsg ) @@ -41,13 +42,14 @@ 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: @@ -77,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 @@ -144,16 +156,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 -> 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) + 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 @@ -212,9 +224,10 @@ checkOptions cli_mode dflags srcs objs = do when (notNull unknown_opts) (unknownFlagsErr unknown_opts) -- -prof and --interactive are not a good combination - when (notNull (wayNames dflags) && isInterpretiveMode cli_mode) $ + when (notNull (filter (/= WayThreaded) (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, -ticky, or -unreg.") -- -ohi sanity check if (isJust (outputHi dflags) && (isCompManagerMode cli_mode || srcs `lengthExceeds` 1))