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
-- 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)
-- 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
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
--
-----------------------------------------------------------------
-processDeps :: Session
+processDeps :: DynFlags
+ -> Session
-> [ModuleName]
-> Handle -- Write dependencies to here
-> SCC ModSummary
--
-- 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
--
-----------------------------------------------------------------
- -- 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
- ]
-
opt_m :: [String],
opt_a :: [String],
opt_l :: [String],
- opt_dep :: [String],
opt_windres :: [String],
-- commands for particular phases
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
opt_a = [],
opt_m = [],
opt_l = [],
- opt_dep = [],
opt_windres = [],
extraPkgConfs = [],
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,
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
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}
, 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
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)
projects / ghc-hetmet.git / commitdiff