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.

diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs
index ffb89c1..1b3792e 100644 (file)
--- a/compiler/main/DriverMkDepend.hs
+++ b/compiler/main/DriverMkDepend.hs
@@ -29,12 +29,10 @@ import Outputable
 import Panic
 import SrcLoc
 import Data.List
 import Panic
 import SrcLoc
 import Data.List

-import CmdLineParser

 import FastString
 
 import ErrUtils         ( debugTraceMsg, putMsg )
 
 import FastString
 
 import ErrUtils         ( debugTraceMsg, putMsg )
 

-import Data.IORef       ( IORef, readIORef, writeIORef )

 import Control.Exception
 import System.Exit      ( ExitCode(..), exitWith )
 import System.Directory
 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
                 -- 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)
         ; 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
 
                 -- 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
 
                 -- 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
 
 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
         -- 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
   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
             -> [ModuleName]
             -> Handle           -- Write dependencies to here
             -> SCC ModSummary

@@ -174,15 +169,15 @@ processDeps :: Session
 --
 -- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
 
 --
 -- 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))
 
   =     -- 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
 
               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"
 
 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 (file)
--- 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_m                 :: [String],
   opt_a                 :: [String],
   opt_l                 :: [String],

-  opt_dep               :: [String],

   opt_windres           :: [String],
 
   -- commands for particular phases
   opt_windres           :: [String],
 
   -- commands for particular phases

@@ -380,6 +379,13 @@ data DynFlags = DynFlags {
   pgm_sysman            :: String,
   pgm_windres           :: String,
 
   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
   --  Package flags
   extraPkgConfs         :: [FilePath],
   topDir                :: FilePath,    -- filled in by SysTools

@@ -541,7 +547,6 @@ defaultDynFlags =
         opt_a                   = [],
         opt_m                   = [],
         opt_l                   = [],
         opt_a                   = [],
         opt_m                   = [],
         opt_l                   = [],

-        opt_dep                 = [],

         opt_windres             = [],
 
         extraPkgConfs           = [],
         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
         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,
         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,
 
 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
          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}
 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}
 
 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}
 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 "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
 
   , 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
         -------- 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
 
 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')
   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)
   when (not (null errs)) $ do
     throwDyn (UsageError (unlines errs))
   return (dflags', leftover, warns)