From 90c32262025049ae3013e8af1e9960756dace72d Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sun, 20 Jul 2008 20:32:39 +0000 Subject: [PATCH] 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. --- compiler/main/DriverMkDepend.hs | 56 +++++++------------------------- compiler/main/DynFlags.hs | 68 +++++++++++++++++++++++++++++++++++---- 2 files changed, 73 insertions(+), 51 deletions(-) diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs index ffb89c1..1b3792e 100644 --- a/compiler/main/DriverMkDepend.hs +++ b/compiler/main/DriverMkDepend.hs @@ -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 - ] - diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 19dc775..1449187 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -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) -- 1.7.10.4