X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FMain.hs;h=a42a67889fbc97c7471f2378ddb2aba7e258d3bd;hb=48b6c777e2e84cc42a27a50642bcb41a0bd2c1d7;hp=4c31fcda90ee74cbc71e01fd026e85cacf4039ab;hpb=e55b3313a0b6db9676f4b25f6243f51015416671;p=ghc-hetmet.git diff --git a/compiler/main/Main.hs b/compiler/main/Main.hs index 4c31fcd..a42a678 100644 --- a/compiler/main/Main.hs +++ b/compiler/main/Main.hs @@ -30,13 +30,14 @@ import InteractiveUI ( interactiveUI, ghciWelcomeMsg ) -- Various other random stuff that we need import Config +import HscTypes import Packages ( dumpPackages ) import DriverPhases ( Phase(..), isSourceFilename, anyHsc, startPhase, isHaskellSrcFilename ) import StaticFlags import DynFlags import BasicTypes ( failed ) -import ErrUtils ( putMsg ) +import ErrUtils import FastString import Outputable import Util @@ -77,10 +78,10 @@ main = mbMinusB | null minusB_args = Nothing | otherwise = Just (drop 2 (last minusB_args)) - argv2 <- parseStaticFlags argv1 + (argv2, staticFlagWarnings) <- parseStaticFlags argv1 -- 2. Parse the "mode" flags (--make, --interactive etc.) - (cli_mode, argv3) <- parseModeFlags argv2 + (cli_mode, argv3, modeFlagWarnings) <- parseModeFlags argv2 -- If all we want to do is to show the version number then do it -- now, before we start a GHC session etc. @@ -128,16 +129,22 @@ main = -- The rest of the arguments are "dynamic" -- Leftover ones are presumably files - (dflags, fileish_args) <- GHC.parseDynamicFlags dflags1 argv3 + (dflags2, fileish_args, dynamicFlagWarnings) <- GHC.parseDynamicFlags dflags1 argv3 + + let flagWarnings = staticFlagWarnings + ++ modeFlagWarnings + ++ dynamicFlagWarnings + handleFlagWarnings dflags2 flagWarnings -- make sure we clean up after ourselves - GHC.defaultCleanupHandler dflags $ do + GHC.defaultCleanupHandler dflags2 $ do - showBanner cli_mode dflags + showBanner cli_mode dflags2 -- we've finished manipulating the DynFlags, update the session - GHC.setSessionDynFlags session dflags - dflags <- GHC.getSessionDynFlags session + GHC.setSessionDynFlags session dflags2 + dflags3 <- GHC.getSessionDynFlags session + hsc_env <- GHC.sessionHscEnv session let -- To simplify the handling of filepaths, we normalise all filepaths right @@ -151,32 +158,32 @@ main = mapM_ (consIORef v_Ld_inputs) (reverse objs) ---------------- Display configuration ----------- - when (verbosity dflags >= 4) $ - dumpPackages dflags + when (verbosity dflags3 >= 4) $ + dumpPackages dflags3 - when (verbosity dflags >= 3) $ do + when (verbosity dflags3 >= 3) $ do hPutStrLn stderr ("Hsc static flags: " ++ unwords staticFlags) ---------------- Final sanity checking ----------- - checkOptions cli_mode dflags srcs objs + checkOptions cli_mode dflags3 srcs objs ---------------- 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) + ShowUsage -> showGhcUsage dflags3 cli_mode + PrintLibdir -> putStrLn (topDir dflags3) ShowSupportedLanguages -> alreadyHandled ShowVersion -> alreadyHandled ShowNumVersion -> alreadyHandled - ShowInterface f -> doShowIface dflags f + ShowInterface f -> doShowIface dflags3 f DoMake -> doMake session srcs DoMkDependHS -> doMkDependHS session (map fst srcs) - StopBefore p -> oneShot dflags p srcs + StopBefore p -> oneShot hsc_env p srcs DoInteractive -> interactiveUI session srcs Nothing DoEval exprs -> interactiveUI session srcs $ Just $ reverse exprs - dumpFinalStats dflags + dumpFinalStats dflags3 exitWith ExitSuccess #ifndef GHCI @@ -353,48 +360,65 @@ isCompManagerMode _ = False -- ----------------------------------------------------------------------------- -- Parsing the mode flag -parseModeFlags :: [String] -> IO (CmdLineMode, [String]) +parseModeFlags :: [String] -> IO (CmdLineMode, [String], [String]) parseModeFlags args = do - let ((leftover, errs), (mode, _, flags)) = + let ((leftover, errs, warns), (mode, _, flags')) = runCmdLine (processArgs mode_flags args) (StopBefore StopLn, "", []) when (not (null errs)) $ do throwDyn (UsageError (unlines errs)) - return (mode, flags ++ leftover) + return (mode, flags' ++ leftover, warns) -type ModeM a = CmdLineP (CmdLineMode, String, [String]) a +type ModeM = CmdLineP (CmdLineMode, String, [String]) -- mode flags sometimes give rise to new DynFlags (eg. -C, see below) -- so we collect the new ones and return them. -mode_flags :: [(String, OptKind (CmdLineP (CmdLineMode, String, [String])))] +mode_flags :: [Flag ModeM] 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)) - , ( "-info" , PassFlag (setMode ShowInfo)) - , ( "-supported-languages", PassFlag (setMode ShowSupportedLanguages)) + Flag "?" (PassFlag (setMode ShowUsage)) + Supported + , Flag "-help" (PassFlag (setMode ShowUsage)) + Supported + , Flag "-print-libdir" (PassFlag (setMode PrintLibdir)) + Supported + , Flag "V" (PassFlag (setMode ShowVersion)) + Supported + , Flag "-version" (PassFlag (setMode ShowVersion)) + Supported + , Flag "-numeric-version" (PassFlag (setMode ShowNumVersion)) + Supported + , Flag "-info" (PassFlag (setMode ShowInfo)) + Supported + , Flag "-supported-languages" (PassFlag (setMode ShowSupportedLanguages)) + Supported ------- interfaces ---------------------------------------------------- - , ( "-show-iface" , HasArg (\f -> setMode (ShowInterface f) - "--show-iface")) + , Flag "-show-iface" (HasArg (\f -> setMode (ShowInterface f) + "--show-iface")) + Supported ------- primary modes ------------------------------------------------ - , ( "M" , PassFlag (setMode DoMkDependHS)) - , ( "E" , PassFlag (setMode (StopBefore anyHsc))) - , ( "C" , PassFlag (\f -> do setMode (StopBefore HCc) f - addFlag "-fvia-C")) - , ( "S" , PassFlag (setMode (StopBefore As))) - , ( "-make" , PassFlag (setMode DoMake)) - , ( "-interactive" , PassFlag (setMode DoInteractive)) - , ( "e" , HasArg (\s -> updateMode (updateDoEval s) "-e")) + , Flag "M" (PassFlag (setMode DoMkDependHS)) + Supported + , Flag "E" (PassFlag (setMode (StopBefore anyHsc))) + Supported + , Flag "C" (PassFlag (\f -> do setMode (StopBefore HCc) f + addFlag "-fvia-C")) + Supported + , Flag "S" (PassFlag (setMode (StopBefore As))) + Supported + , Flag "-make" (PassFlag (setMode DoMake)) + Supported + , Flag "-interactive" (PassFlag (setMode DoInteractive)) + Supported + , Flag "e" (HasArg (\s -> updateMode (updateDoEval s) "-e")) + Supported -- -fno-code says to stop after Hsc but don't generate any code. - , ( "fno-code" , PassFlag (\f -> do setMode (StopBefore HCc) f - addFlag "-fno-code" - addFlag "-no-recomp")) + , Flag "fno-code" (PassFlag (\f -> do setMode (StopBefore HCc) f + addFlag "-fno-code" + addFlag "-fforce-recomp")) + Supported ] setMode :: CmdLineMode -> String -> ModeM () @@ -406,16 +430,16 @@ updateDoEval expr _ = DoEval [expr] updateMode :: (CmdLineMode -> CmdLineMode) -> String -> ModeM () updateMode f flag = do - (old_mode, old_flag, flags) <- getCmdLineState + (old_mode, old_flag, flags') <- getCmdLineState if notNull old_flag && flag /= old_flag then throwDyn (UsageError ("cannot use `" ++ old_flag ++ "' with `" ++ flag ++ "'")) - else putCmdLineState (f old_mode, flag, flags) + else putCmdLineState (f old_mode, flag, flags') addFlag :: String -> ModeM () addFlag s = do - (m, f, flags) <- getCmdLineState - putCmdLineState (m, f, s:flags) + (m, f, flags') <- getCmdLineState + putCmdLineState (m, f, s:flags') -- ---------------------------------------------------------------------------- @@ -431,8 +455,8 @@ doMake sess srcs = do haskellish (_,Just phase) = phase `notElem` [As, Cc, CmmCpp, Cmm, StopLn] - dflags <- GHC.getSessionDynFlags sess - o_files <- mapM (compileFile dflags StopLn) non_hs_srcs + hsc_env <- GHC.sessionHscEnv sess + o_files <- mapM (compileFile hsc_env StopLn) non_hs_srcs mapM_ (consIORef v_Ld_inputs) (reverse o_files) targets <- mapM (uncurry GHC.guessTarget) hs_srcs