-- 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
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.
-- 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
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
-- -----------------------------------------------------------------------------
-- 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 ()
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')
-- ----------------------------------------------------------------------------
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
projects / ghc-hetmet.git / blobdiff