X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2FMain.hs;h=b75548be5feb26a1379017bd9ff0ce9c9688f1c9;hb=b980fbf46aad86bab37a628cb8dc7f7602d7452d;hp=840f84341d53df486973c668a0f1eb1b125acedd;hpb=d1984e439154e95b2804ee83897e740b1713c53d;p=ghc-hetmet.git diff --git a/ghc/Main.hs b/ghc/Main.hs index 840f843..b75548b 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -35,11 +35,13 @@ import Packages ( dumpPackages ) import DriverPhases ( Phase(..), isSourceFilename, anyHsc, startPhase, isHaskellSrcFilename ) import StaticFlags +import StaticFlagParser import DynFlags import BasicTypes ( failed ) import ErrUtils import FastString import Outputable +import SrcLoc import Util import Panic @@ -76,7 +78,8 @@ main = mbMinusB | null minusB_args = Nothing | otherwise = Just (drop 2 (last minusB_args)) - (argv2, staticFlagWarnings) <- parseStaticFlags argv1 + let argv1' = map (mkGeneralLocated "on the commandline") argv1 + (argv2, staticFlagWarnings) <- parseStaticFlags argv1' -- 2. Parse the "mode" flags (--make, --interactive etc.) (cli_mode, argv3, modeFlagWarnings) <- parseModeFlags argv2 @@ -155,7 +158,7 @@ main = -- To simplify the handling of filepaths, we normalise all filepaths right -- away - e.g., for win32 platforms, backslashes are converted -- into forward slashes. - normal_fileish_paths = map normalise fileish_args + normal_fileish_paths = map (normalise . unLoc) fileish_args (srcs, objs) = partition_args normal_fileish_paths [] [] -- Note: have v_Ld_inputs maintain the order in which 'objs' occurred on @@ -361,15 +364,15 @@ isCompManagerMode _ = False -- ----------------------------------------------------------------------------- -- Parsing the mode flag -parseModeFlags :: [String] -> IO (CmdLineMode, [String], [String]) +parseModeFlags :: [Located String] + -> IO (CmdLineMode, [Located String], [Located String]) parseModeFlags args = do let ((leftover, errs, warns), (mode, _, flags')) = runCmdLine (processArgs mode_flags args) (StopBefore StopLn, "", []) - when (not (null errs)) $ do - ghcError (UsageError (unlines errs)) + when (not (null errs)) $ ghcError $ errorsToGhcException errs return (mode, flags' ++ leftover, warns) -type ModeM = CmdLineP (CmdLineMode, String, [String]) +type ModeM = CmdLineP (CmdLineMode, String, [Located String]) -- mode flags sometimes give rise to new DynFlags (eg. -C, see below) -- so we collect the new ones and return them. @@ -440,7 +443,8 @@ updateMode f flag = do addFlag :: String -> ModeM () addFlag s = do (m, f, flags') <- getCmdLineState - putCmdLineState (m, f, s:flags') + -- XXX Can we get a useful Loc? + putCmdLineState (m, f, mkGeneralLocated "addFlag" s : flags') -- ----------------------------------------------------------------------------