X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2FMain.hs;h=b75548be5feb26a1379017bd9ff0ce9c9688f1c9;hb=fb0a3438b4a3c3df99cbe35baab7da97150d41cd;hp=a91df13575c1f2ce49f56664331a92f05b9cb258;hpb=9412e62942ebab0599c7fb0b358a9d4869647b67;p=ghc-hetmet.git diff --git a/ghc/Main.hs b/ghc/Main.hs index a91df13..b75548b 100644 --- a/ghc/Main.hs +++ b/ghc/Main.hs @@ -35,16 +35,17 @@ 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 -- Standard Haskell libraries -import Control.Exception ( throwDyn ) import System.IO import System.Environment import System.Exit @@ -77,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 @@ -126,9 +128,16 @@ main = _other -> 1 } + -- turn on -fimplicit-import-qualified for GHCi now, so that it + -- can be overriden from the command-line + dflags1a | DoInteractive <- cli_mode = imp_qual_enabled + | DoEval _ <- cli_mode = imp_qual_enabled + | otherwise = dflags1 + where imp_qual_enabled = dflags1 `dopt_set` Opt_ImplicitImportQualified + -- The rest of the arguments are "dynamic" -- Leftover ones are presumably files - (dflags2, fileish_args, dynamicFlagWarnings) <- GHC.parseDynamicFlags dflags1 argv3 + (dflags2, fileish_args, dynamicFlagWarnings) <- GHC.parseDynamicFlags dflags1a argv3 let flagWarnings = staticFlagWarnings ++ modeFlagWarnings @@ -149,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 @@ -188,7 +197,7 @@ main = #ifndef GHCI interactiveUI :: a -> b -> c -> IO () interactiveUI _ _ _ = - throwDyn (CmdLineError "not built for interactive use") + ghcError (CmdLineError "not built for interactive use") #endif -- ----------------------------------------------------------------------------- @@ -249,24 +258,24 @@ checkOptions cli_mode dflags srcs objs = do -- -prof and --interactive are not a good combination when (notNull (filter (not . isRTSWay) (wayNames dflags)) && isInterpretiveMode cli_mode) $ - do throwDyn (UsageError + do ghcError (UsageError "--interactive can't be used with -prof or -unreg.") -- -ohi sanity check if (isJust (outputHi dflags) && (isCompManagerMode cli_mode || srcs `lengthExceeds` 1)) - then throwDyn (UsageError "-ohi can only be used when compiling a single source file") + then ghcError (UsageError "-ohi can only be used when compiling a single source file") else do -- -o sanity checking if (srcs `lengthExceeds` 1 && isJust (outputFile dflags) && not (isLinkMode cli_mode)) - then throwDyn (UsageError "can't apply -o to multiple source files") + then ghcError (UsageError "can't apply -o to multiple source files") else do -- Check that there are some input files -- (except in the interactive case) if null srcs && null objs && needsInputsMode cli_mode - then throwDyn (UsageError "no input files") + then ghcError (UsageError "no input files") else do -- Verify that output files point somewhere sensible. @@ -297,7 +306,7 @@ verifyOutputFiles dflags = do when (not flg) (nonExistentDir "-ohi" hi) where nonExistentDir flg dir = - throwDyn (CmdLineError ("error: directory portion of " ++ + ghcError (CmdLineError ("error: directory portion of " ++ show dir ++ " does not exist (used with " ++ show flg ++ " option.)")) @@ -355,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 - throwDyn (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. @@ -427,21 +436,22 @@ updateMode :: (CmdLineMode -> CmdLineMode) -> String -> ModeM () updateMode f flag = do (old_mode, old_flag, flags') <- getCmdLineState if notNull old_flag && flag /= old_flag - then throwDyn (UsageError + then ghcError (UsageError ("cannot use `" ++ old_flag ++ "' with `" ++ flag ++ "'")) else putCmdLineState (f old_mode, flag, flags') 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') -- ---------------------------------------------------------------------------- -- Run --make mode doMake :: Session -> [(String,Maybe Phase)] -> IO () -doMake _ [] = throwDyn (UsageError "no input files") +doMake _ [] = ghcError (UsageError "no input files") doMake sess srcs = do let (hs_srcs, non_hs_srcs) = partition haskellish srcs @@ -560,4 +570,4 @@ countFS entries longest is_z has_z (b:bs) = -- Util unknownFlagsErr :: [String] -> a -unknownFlagsErr fs = throwDyn (UsageError ("unrecognised flags: " ++ unwords fs)) +unknownFlagsErr fs = ghcError (UsageError ("unrecognised flags: " ++ unwords fs))