import Config
import CmdLineParser
import Constants ( mAX_CONTEXT_REDUCTION_DEPTH )
-import Panic ( panic, GhcException(..) )
+import Panic
import UniqFM ( UniqFM )
import Util
import Maybes ( orElse )
import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage )
import Data.IORef ( readIORef )
-import Control.Exception ( throwDyn )
import Control.Monad ( when )
import Data.Char
| Opt_WarnDodgyImports
| Opt_WarnOrphans
| Opt_WarnTabs
+ | Opt_WarnUnrecognisedPragmas
| Opt_WarnDodgyForeignImports
-- language opts
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}
standardWarnings
= [ Opt_WarnWarningsDeprecations,
Opt_WarnDeprecatedFlags,
+ Opt_WarnUnrecognisedPragmas,
Opt_WarnOverlappingPatterns,
Opt_WarnMissingFields,
Opt_WarnMissingMethods,
Opt_WarnIncompletePatternsRecUpd,
Opt_WarnSimplePatterns,
Opt_WarnMonomorphism,
+ Opt_WarnUnrecognisedPragmas,
Opt_WarnTabs
]
, 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 "dep-suffix" (HasArg (upd . addDepSuffix)) Supported
+ , Flag "optdep-s" (HasArg (upd . addDepSuffix))
+ (Deprecated "Use -dep-suffix instead")
+ , Flag "dep-makefile" (HasArg (upd . setDepMakefile)) Supported
+ , Flag "optdep-f" (HasArg (upd . setDepMakefile))
+ (Deprecated "Use -dep-makefile instead")
+ , Flag "optdep-w" (NoArg (upd (setDepWarnings False)))
+ (Deprecated "-optdep-w doesn't do anything")
+ , Flag "include-pkg-deps" (NoArg (upd (setDepIncludePkgDeps True))) Supported
+ , Flag "optdep--include-prelude" (NoArg (upd (setDepIncludePkgDeps True)))
+ (Deprecated "Use -include-pkg-deps instead")
+ , Flag "optdep--include-pkg-deps" (NoArg (upd (setDepIncludePkgDeps True)))
+ (Deprecated "Use -include-pkg-deps instead")
+ , Flag "exclude-module" (HasArg (upd . addDepExcludeMod)) Supported
+ , Flag "optdep--exclude-module" (HasArg (upd . addDepExcludeMod))
+ (Deprecated "Use -exclude-module instead")
+ , Flag "optdep-x" (HasArg (upd . addDepExcludeMod))
+ (Deprecated "Use -exclude-module instead")
+
-------- Linking ----------------------------------------------------
, Flag "c" (NoArg (upd $ \d -> d{ ghcLink=NoLink } ))
Supported
( "warn-deprecated-flags", Opt_WarnDeprecatedFlags, const Supported ),
( "warn-orphans", Opt_WarnOrphans, const Supported ),
( "warn-tabs", Opt_WarnTabs, const Supported ),
+ ( "warn-unrecognised-pragmas", Opt_WarnUnrecognisedPragmas, const Supported ),
( "print-explicit-foralls", Opt_PrintExplicitForalls, const Supported ),
( "strictness", Opt_Strictness, const Supported ),
( "static-argument-transformation", Opt_StaticArgumentTransformation, const 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))
+ ghcError (UsageError (unlines errs))
return (dflags', leftover, warns)
type DynP = CmdLineP DynFlags
setPackageName :: String -> DynFlags -> DynFlags
setPackageName p
| Nothing <- unpackPackageId pid
- = throwDyn (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
+ = ghcError (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier"))
| otherwise
= \s -> s{ thisPackage = pid }
where