Commit 90c32262 authored by Ian Lynagh's avatar Ian Lynagh

First step for getting rid of the old -optdep flags

They are now handled by the main flag parser, rather than having their
own praser that runs later.

As an added bonus, 5 global variables are also gone.
parent 6ec0a23d
......@@ -29,12 +29,10 @@ import Outputable
import Panic
import SrcLoc
import Data.List
import CmdLineParser
import FastString
import ErrUtils ( debugTraceMsg, putMsg )
import Data.IORef ( IORef, readIORef, writeIORef )
import Control.Exception
import System.Exit ( ExitCode(..), exitWith )
import System.Directory
......@@ -59,7 +57,7 @@ doMkDependHS session srcs
-- Do the downsweep to find all the modules
; targets <- mapM (\s -> GHC.guessTarget s Nothing) srcs
; GHC.setTargets session targets
; excl_mods <- readIORef v_Dep_exclude_mods
; let excl_mods = depExcludeMods dflags
; r <- GHC.depanal session excl_mods True {- Allow dup roots -}
; case r of
Nothing -> exitWith (ExitFailure 1)
......@@ -74,7 +72,7 @@ doMkDependHS session srcs
-- Prcess them one by one, dumping results into makefile
-- and complaining about cycles
; mapM (processDeps session excl_mods (mkd_tmp_hdl files)) sorted
; mapM (processDeps dflags session excl_mods (mkd_tmp_hdl files)) sorted
-- If -ddump-mod-cycles, show cycles in the module graph
; dumpModCycles dflags mod_summaries
......@@ -99,17 +97,13 @@ data MkDepFiles
beginMkDependHS :: DynFlags -> IO MkDepFiles
beginMkDependHS dflags = do
-- slurp in the mkdependHS-style options
let flags = getOpts dflags opt_dep
_ <- processArgs dep_opts flags
-- open a new temp file in which to stuff the dependency info
-- as we go along.
tmp_file <- newTempName dflags "dep"
tmp_hdl <- openFile tmp_file WriteMode
-- open the makefile
makefile <- readIORef v_Dep_makefile
let makefile = depMakefile dflags
exists <- doesFileExist makefile
mb_make_hdl <-
if not exists
......@@ -154,7 +148,8 @@ beginMkDependHS dflags = do
--
-----------------------------------------------------------------
processDeps :: Session
processDeps :: DynFlags
-> Session
-> [ModuleName]
-> Handle -- Write dependencies to here
-> SCC ModSummary
......@@ -174,15 +169,15 @@ processDeps :: Session
--
-- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
processDeps _ _ _ (CyclicSCC nodes)
processDeps _ _ _ _ (CyclicSCC nodes)
= -- There shouldn't be any cycles; report them
throwDyn (ProgramError (showSDoc $ GHC.cyclicModuleErr nodes))
processDeps session excl_mods hdl (AcyclicSCC node)
= do { extra_suffixes <- readIORef v_Dep_suffixes
; hsc_env <- GHC.sessionHscEnv session
; include_pkg_deps <- readIORef v_Dep_include_pkg_deps
; let src_file = msHsFilePath node
processDeps dflags session excl_mods hdl (AcyclicSCC node)
= do { hsc_env <- GHC.sessionHscEnv session
; let extra_suffixes = depSuffixes dflags
include_pkg_deps = depIncludePkgDeps dflags
src_file = msHsFilePath node
obj_file = msObjFilePath node
obj_files = insertSuffixes obj_file extra_suffixes
......@@ -384,36 +379,7 @@ pprCycle summaries = pp_group (CyclicSCC summaries)
--
-----------------------------------------------------------------
-- Flags
GLOBAL_VAR(v_Dep_makefile, "Makefile", String);
GLOBAL_VAR(v_Dep_include_pkg_deps, False, Bool);
GLOBAL_VAR(v_Dep_exclude_mods, [], [ModuleName]);
GLOBAL_VAR(v_Dep_suffixes, [], [String]);
GLOBAL_VAR(v_Dep_warnings, True, Bool);
depStartMarker, depEndMarker :: String
depStartMarker = "# DO NOT DELETE: Beginning of Haskell dependencies"
depEndMarker = "# DO NOT DELETE: End of Haskell dependencies"
-- for compatibility with the old mkDependHS, we accept options of the form
-- -optdep-f -optdep.depend, etc.
dep_opts :: [Flag IO]
dep_opts =
[ Flag "s" (SepArg (consIORef v_Dep_suffixes))
Supported
, Flag "f" (SepArg (writeIORef v_Dep_makefile))
Supported
, Flag "w" (NoArg (writeIORef v_Dep_warnings False))
Supported
, Flag "-include-prelude" (NoArg (writeIORef v_Dep_include_pkg_deps True))
(Deprecated "Use --include-pkg-deps instead")
, Flag "-include-pkg-deps" (NoArg (writeIORef v_Dep_include_pkg_deps True))
Supported
, Flag "-exclude-module=" (Prefix (consIORef v_Dep_exclude_mods . mkModuleName))
Supported
, Flag "x" (Prefix (consIORef v_Dep_exclude_mods . mkModuleName))
Supported
]
......@@ -363,7 +363,6 @@ data DynFlags = DynFlags {
opt_m :: [String],
opt_a :: [String],
opt_l :: [String],
opt_dep :: [String],
opt_windres :: [String],
-- commands for particular phases
......@@ -380,6 +379,13 @@ data DynFlags = DynFlags {
pgm_sysman :: String,
pgm_windres :: String,
-- For ghc -M
depMakefile :: FilePath,
depIncludePkgDeps :: Bool,
depExcludeMods :: [ModuleName],
depSuffixes :: [String],
depWarnings :: Bool,
-- Package flags
extraPkgConfs :: [FilePath],
topDir :: FilePath, -- filled in by SysTools
......@@ -541,7 +547,6 @@ defaultDynFlags =
opt_a = [],
opt_m = [],
opt_l = [],
opt_dep = [],
opt_windres = [],
extraPkgConfs = [],
......@@ -569,6 +574,13 @@ defaultDynFlags =
pgm_sysman = panic "defaultDynFlags: No pgm_sysman",
pgm_windres = panic "defaultDynFlags: No pgm_windres",
-- end of initSysTools values
-- ghc -M values
depMakefile = "Makefile",
depIncludePkgDeps = False,
depExcludeMods = [],
depSuffixes = [],
depWarnings = True,
-- end of ghc -M values
haddockOptions = Nothing,
flags = [
Opt_AutoLinkPackages,
......@@ -636,7 +648,7 @@ getVerbFlag dflags
setObjectDir, setHiDir, setStubDir, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres,
addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptdep, addOptwindres,
addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres,
addCmdlineFramework, addHaddockOpts
:: String -> DynFlags -> DynFlags
setOutputFile, setOutputHi, setDumpPrefixForce
......@@ -687,9 +699,32 @@ addOptc f d = d{ opt_c = f : opt_c d}
addOptm f d = d{ opt_m = f : opt_m d}
addOpta f d = d{ opt_a = f : opt_a d}
addOptl f d = d{ opt_l = f : opt_l d}
addOptdep f d = d{ opt_dep = f : opt_dep d}
addOptwindres f d = d{ opt_windres = f : opt_windres d}
setDepMakefile :: FilePath -> DynFlags -> DynFlags
setDepMakefile f d = d { depMakefile = deOptDep f }
setDepIncludePkgDeps :: Bool -> DynFlags -> DynFlags
setDepIncludePkgDeps b d = d { depIncludePkgDeps = b }
addDepExcludeMod :: String -> DynFlags -> DynFlags
addDepExcludeMod m d
= d { depExcludeMods = mkModuleName (deOptDep m) : depExcludeMods d }
addDepSuffix :: FilePath -> DynFlags -> DynFlags
addDepSuffix s d = d { depSuffixes = deOptDep s : depSuffixes d }
setDepWarnings :: Bool -> DynFlags -> DynFlags
setDepWarnings b d = d { depWarnings = b }
-- XXX Legacy code:
-- We used to use "-optdep-flag -optdeparg", so for legacy applications
-- we need to strip the "-optdep" off of the arg
deOptDep :: String -> String
deOptDep x = case maybePrefixMatch "-optdep" x of
Just rest -> rest
Nothing -> x
addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d}
addHaddockOpts f d = d{ haddockOptions = Just f}
......@@ -1064,13 +1099,23 @@ dynamic_flags = [
, Flag "optm" (HasArg (upd . addOptm)) Supported
, Flag "opta" (HasArg (upd . addOpta)) Supported
, Flag "optl" (HasArg (upd . addOptl)) Supported
, Flag "optdep" (HasArg (upd . addOptdep)) Supported
, Flag "optwindres" (HasArg (upd . addOptwindres)) Supported
, Flag "split-objs"
(NoArg (if can_split then setDynFlag Opt_SplitObjs else return ()))
Supported
-------- ghc -M -----------------------------------------------------
, Flag "optdep-s" (HasArg (upd . addDepSuffix)) Supported
, Flag "optdep-f" (HasArg (upd . setDepMakefile)) Supported
, Flag "optdep-w" (NoArg (upd (setDepWarnings False)))
(Deprecated "-optdep-w doesn't do anything")
, Flag "optdep--include-prelude" (NoArg (upd (setDepIncludePkgDeps True)))
(Deprecated "Use -optdep--include-pkg-deps instead")
, Flag "optdep--include-pkg-deps" (NoArg (upd (setDepIncludePkgDeps True))) Supported
, Flag "optdep--exclude-module" (HasArg (upd . addDepExcludeMod)) Supported
, Flag "optdep-x" (HasArg (upd . addDepExcludeMod)) Supported
-------- Linking ----------------------------------------------------
, Flag "c" (NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
Supported
......@@ -1596,8 +1641,19 @@ glasgowExtsFlags = [
parseDynamicFlags :: DynFlags -> [String] -> IO (DynFlags, [String], [String])
parseDynamicFlags dflags args = do
-- XXX Legacy support code
-- We used to accept things like
-- optdep-f -optdepdepend
-- optdep-f -optdep depend
-- optdep -f -optdepdepend
-- optdep -f -optdep depend
-- but the spaces trip up proper argument handling. So get rid of them.
let f ("-optdep" : x : xs) = ("-optdep" ++ x) : f xs
f (x : xs) = x : f xs
f xs = xs
args' = f args
let ((leftover, errs, warns), dflags')
= runCmdLine (processArgs dynamic_flags args) dflags
= runCmdLine (processArgs dynamic_flags args') dflags
when (not (null errs)) $ do
throwDyn (UsageError (unlines errs))
return (dflags', leftover, warns)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment