X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=3bb7c1ccd0d104a48a339e024a3daa3a75391d80;hb=beea3d146a69be0986d8783c3de2864f62a88c79;hp=3e030f2e908531dbbdd68525cf5913a4a9b99710;hpb=beded1205911615ac7c1cd175def682eaf8daa1e;p=ghc-hetmet.git diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 3e030f2..3bb7c1c 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -83,7 +83,7 @@ import Control.Monad ( when ) import Data.Char import System.FilePath -import System.IO ( hPutStrLn, stderr ) +import System.IO ( stderr, hPutChar ) -- ----------------------------------------------------------------------------- -- DynFlags @@ -169,11 +169,12 @@ data DynFlag | Opt_WarnUnusedBinds | Opt_WarnUnusedImports | Opt_WarnUnusedMatches - | Opt_WarnDeprecations + | Opt_WarnWarningsDeprecations | Opt_WarnDeprecatedFlags | Opt_WarnDodgyImports | Opt_WarnOrphans | Opt_WarnTabs + | Opt_WarnUnrecognisedPragmas | Opt_WarnDodgyForeignImports -- language opts @@ -363,7 +364,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 +380,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 +548,6 @@ defaultDynFlags = opt_a = [], opt_m = [], opt_l = [], - opt_dep = [], opt_windres = [], extraPkgConfs = [], @@ -569,6 +575,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, @@ -595,9 +608,14 @@ defaultDynFlags = log_action = \severity srcSpan style msg -> case severity of - SevInfo -> hPutStrLn stderr (show (msg style)) - SevFatal -> hPutStrLn stderr (show (msg style)) - _ -> hPutStrLn stderr ('\n':show ((mkLocMessage srcSpan msg) style)) + SevInfo -> printErrs (msg style) + SevFatal -> printErrs (msg style) + _ -> do + hPutChar stderr '\n' + printErrs ((mkLocMessage srcSpan msg) style) + -- careful (#2302): printErrs prints in UTF-8, whereas + -- converting to string first and using hPutStr would + -- just emit the low 8 bits of each unicode char. } {- @@ -631,7 +649,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 @@ -641,7 +659,7 @@ setObjectDir f d = d{ objectDir = Just f} setHiDir f d = d{ hiDir = Just f} setStubDir f d = d{ stubDir = Just f, includePaths = f : includePaths d } -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file - -- #included from the .hc file when compiling with -fvia-C. + -- \#included from the .hc file when compiling with -fvia-C. setObjectSuf f d = d{ objectSuf = f} setHiSuf f d = d{ hiSuf = f} @@ -682,9 +700,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} @@ -751,8 +792,9 @@ optLevelFlags standardWarnings :: [DynFlag] standardWarnings - = [ Opt_WarnDeprecations, + = [ Opt_WarnWarningsDeprecations, Opt_WarnDeprecatedFlags, + Opt_WarnUnrecognisedPragmas, Opt_WarnOverlappingPatterns, Opt_WarnMissingFields, Opt_WarnMissingMethods, @@ -788,6 +830,7 @@ minuswRemovesOpts Opt_WarnIncompletePatternsRecUpd, Opt_WarnSimplePatterns, Opt_WarnMonomorphism, + Opt_WarnUnrecognisedPragmas, Opt_WarnTabs ] @@ -1059,13 +1102,32 @@ 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 "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 @@ -1402,10 +1464,11 @@ fFlags = [ ( "warn-unused-binds", Opt_WarnUnusedBinds, const Supported ), ( "warn-unused-imports", Opt_WarnUnusedImports, const Supported ), ( "warn-unused-matches", Opt_WarnUnusedMatches, const Supported ), - ( "warn-deprecations", Opt_WarnDeprecations, const Supported ), + ( "warn-warnings-deprecations", Opt_WarnWarningsDeprecations, const 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 ), @@ -1591,8 +1654,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)