X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=ad327bda0fcd631b1c7907e46669369d574c1d8d;hp=bee06f18e4264fd0c8b86ec3983b26d03a37590e;hb=cae75f82226638691cfa1e85fc168f4b65ddce4d;hpb=17b297d97d327620ed6bfab942f8992b2446f1bf diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index bee06f1..ad327bd 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1,5 +1,4 @@ -{-# OPTIONS -fno-warn-missing-fields #-} ----------------------------------------------------------------------------- -- -- Dynamic flags @@ -13,86 +12,78 @@ -- ----------------------------------------------------------------------------- -{-# OPTIONS_GHC -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings --- for details - module DynFlags ( - -- Dynamic flags - DynFlag(..), - DynFlags(..), - HscTarget(..), isObjectTarget, defaultObjectTarget, - GhcMode(..), isOneShot, - GhcLink(..), isNoLink, - PackageFlag(..), - Option(..), - - -- Configuration of the core-to-core and stg-to-stg phases - CoreToDo(..), - StgToDo(..), - SimplifierSwitch(..), - SimplifierMode(..), FloatOutSwitches(..), - getCoreToDo, getStgToDo, - - -- Manipulating DynFlags - defaultDynFlags, -- DynFlags - initDynFlags, -- DynFlags -> IO DynFlags - - dopt, -- DynFlag -> DynFlags -> Bool - dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags - getOpts, -- (DynFlags -> [a]) -> IO [a] - getVerbFlag, - updOptLevel, - setTmpDir, - setPackageName, - - -- parsing DynFlags - parseDynamicFlags, + -- Dynamic flags + DynFlag(..), + DynFlags(..), + HscTarget(..), isObjectTarget, defaultObjectTarget, + GhcMode(..), isOneShot, + GhcLink(..), isNoLink, + PackageFlag(..), + Option(..), + DynLibLoader(..), + fFlags, xFlags, + DPHBackend(..), + + -- Configuration of the core-to-core and stg-to-stg phases + CoreToDo(..), + StgToDo(..), + SimplifierSwitch(..), + SimplifierMode(..), FloatOutSwitches(..), + getCoreToDo, getStgToDo, + + -- Manipulating DynFlags + defaultDynFlags, -- DynFlags + initDynFlags, -- DynFlags -> IO DynFlags + + dopt, -- DynFlag -> DynFlags -> Bool + dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags + getOpts, -- (DynFlags -> [a]) -> IO [a] + getVerbFlag, + updOptLevel, + setTmpDir, + setPackageName, + + -- parsing DynFlags + parseDynamicFlags, allFlags, - -- misc stuff - machdepCCOpts, picCCOpts, - supportedLanguages, + -- misc stuff + machdepCCOpts, picCCOpts, + supportedLanguages, languageOptions, compilerInfo, ) where #include "HsVersions.h" -import Module ( Module, mkModuleName, mkModule, ModLocation ) +import Module import PackageConfig -import PrelNames ( mAIN ) +import PrelNames ( mAIN ) #ifdef i386_TARGET_ARCH -import StaticFlags ( opt_Static ) +import StaticFlags ( opt_Static ) #endif -import StaticFlags ( opt_PIC, WayName(..), v_Ways, v_Build_tag, - v_RTS_Build_tag ) +import StaticFlags ( opt_PIC, WayName(..), v_Ways, v_Build_tag, + v_RTS_Build_tag ) import {-# SOURCE #-} Packages (PackageState) -import DriverPhases ( Phase(..), phaseInputExt ) +import DriverPhases ( Phase(..), phaseInputExt ) import Config import CmdLineParser -import Constants ( mAX_CONTEXT_REDUCTION_DEPTH ) -import Panic ( panic, GhcException(..) ) +import Constants ( mAX_CONTEXT_REDUCTION_DEPTH ) +import Panic ( panic, GhcException(..) ) import UniqFM ( UniqFM ) import Util -import Maybes ( orElse, fromJust ) +import Maybes ( orElse ) import SrcLoc ( SrcSpan ) import Outputable import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) -import Data.IORef ( readIORef ) +import Data.IORef ( readIORef ) import Control.Exception ( throwDyn ) -import Control.Monad ( when ) -#ifdef mingw32_TARGET_OS -import Data.List ( isPrefixOf ) -#else -import Util ( split ) -#endif +import Control.Monad ( when ) -import Data.Char ( isUpper, toLower ) -import System.IO ( hPutStrLn, stderr ) +import Data.Char +import System.FilePath +import System.IO ( stderr, hPutChar ) -- ----------------------------------------------------------------------------- -- DynFlags @@ -101,7 +92,10 @@ data DynFlag -- debugging flags = Opt_D_dump_cmm + | Opt_D_dump_cmmz + | Opt_D_dump_cmmz_pretty | Opt_D_dump_cps_cmm + | Opt_D_dump_cvt_cmm | Opt_D_dump_asm | Opt_D_dump_asm_native | Opt_D_dump_asm_liveness @@ -122,6 +116,7 @@ data DynFlag | Opt_D_dump_rn | Opt_D_dump_simpl | Opt_D_dump_simpl_iterations + | Opt_D_dump_simpl_phases | Opt_D_dump_spec | Opt_D_dump_prep | Opt_D_dump_stg @@ -148,13 +143,16 @@ data DynFlag | Opt_D_dump_hi_diffs | Opt_D_dump_minimal_imports | Opt_D_dump_mod_cycles + | Opt_D_dump_view_pattern_commoning | Opt_D_faststring_stats - | Opt_DumpToFile -- ^ Append dump output to files instead of stdout. + | Opt_DumpToFile -- ^ Append dump output to files instead of stdout. + | Opt_D_no_debug_output | Opt_DoCoreLinting | Opt_DoStgLinting | Opt_DoCmmLinting + | Opt_DoAsmLinting - | Opt_WarnIsError -- -Werror; makes warnings fatal + | Opt_WarnIsError -- -Werror; makes warnings fatal | Opt_WarnDuplicateExports | Opt_WarnHiShadows | Opt_WarnImplicitPrelude @@ -171,10 +169,12 @@ data DynFlag | Opt_WarnUnusedBinds | Opt_WarnUnusedImports | Opt_WarnUnusedMatches - | Opt_WarnDeprecations + | Opt_WarnWarningsDeprecations + | Opt_WarnDeprecatedFlags | Opt_WarnDodgyImports | Opt_WarnOrphans | Opt_WarnTabs + | Opt_WarnDodgyForeignImports -- language opts | Opt_OverlappingInstances @@ -182,15 +182,16 @@ data DynFlag | Opt_IncoherentInstances | Opt_MonomorphismRestriction | Opt_MonoPatBinds - | Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting + | Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting | Opt_ForeignFunctionInterface | Opt_UnliftedFFITypes - | Opt_PArr -- Syntactic support for parallel arrays - | Opt_Arrows -- Arrow-notation syntax + | Opt_PArr -- Syntactic support for parallel arrays + | Opt_Arrows -- Arrow-notation syntax | Opt_TemplateHaskell + | Opt_QuasiQuotes | Opt_ImplicitParams | Opt_Generics - | Opt_ImplicitPrelude + | Opt_ImplicitPrelude | Opt_ScopedTypeVariables | Opt_UnboxedTuples | Opt_BangPatterns @@ -199,6 +200,7 @@ data DynFlag | Opt_DisambiguateRecordFields | Opt_RecordWildCards | Opt_RecordPuns + | Opt_ViewPatterns | Opt_GADTs | Opt_RelaxedPolyRec | Opt_StandaloneDeriving @@ -217,12 +219,15 @@ data DynFlag | Opt_KindSignatures | Opt_PatternSignatures | Opt_ParallelListComp + | Opt_TransformListComp | Opt_GeneralizedNewtypeDeriving | Opt_RecursiveDo + | Opt_PostfixOperators | Opt_PatternGuards - | Opt_PartiallyAppliedClosedTypeSynonyms + | Opt_LiberalTypeSynonyms | Opt_Rank2Types | Opt_RankNTypes + | Opt_ImpredicativeTypes | Opt_TypeOperators | Opt_PrintExplicitForalls @@ -230,6 +235,7 @@ data DynFlag -- optimisation opts | Opt_Strictness | Opt_FullLaziness + | Opt_StaticArgumentTransformation | Opt_CSE | Opt_LiberateCase | Opt_SpecConstr @@ -237,14 +243,15 @@ data DynFlag | Opt_OmitInterfacePragmas | Opt_DoLambdaEtaExpansion | Opt_IgnoreAsserts - | Opt_IgnoreBreakpoints | Opt_DoEtaReduction | Opt_CaseMerge | Opt_UnboxStrictFields + | Opt_MethodSharing | Opt_DictsCheap | Opt_RewriteRules | Opt_Vectorise - | Opt_RegsGraph + | Opt_RegsGraph -- do graph coloring register allocation + | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation -- misc opts | Opt_Cpp @@ -260,10 +267,17 @@ data DynFlag | Opt_HideAllPackages | Opt_PrintBindResult | Opt_Haddock + | Opt_HaddockOptions | Opt_Hpc_No_Auto | Opt_BreakOnException + | Opt_BreakOnError + | Opt_PrintEvldWithShow + | Opt_PrintBindContents | Opt_GenManifest | Opt_EmbedManifest + | Opt_RunCPSZ + | Opt_ConvertToZipCfgAndBack + | Opt_AutoLinkPackages -- keeping stuff | Opt_KeepHiDiffs @@ -273,113 +287,122 @@ data DynFlag | Opt_KeepTmpFiles deriving (Eq, Show) - + data DynFlags = DynFlags { - ghcMode :: GhcMode, - ghcLink :: GhcLink, - coreToDo :: Maybe [CoreToDo], -- reserved for -Ofile - stgToDo :: Maybe [StgToDo], -- similarly - hscTarget :: HscTarget, - hscOutName :: String, -- name of the output file - extCoreName :: String, -- name of the .core output file - verbosity :: Int, -- verbosity level - optLevel :: Int, -- optimisation level - maxSimplIterations :: Int, -- max simplifier iterations - ruleCheck :: Maybe String, - - specThreshold :: Int, -- Threshold for function specialisation - - stolen_x86_regs :: Int, - cmdlineHcIncludes :: [String], -- -#includes - importPaths :: [FilePath], - mainModIs :: Module, - mainFunIs :: Maybe String, - ctxtStkDepth :: Int, -- Typechecker context stack depth - - thisPackage :: PackageId, + ghcMode :: GhcMode, + ghcLink :: GhcLink, + coreToDo :: Maybe [CoreToDo], -- reserved for -Ofile + stgToDo :: Maybe [StgToDo], -- similarly + hscTarget :: HscTarget, + hscOutName :: String, -- name of the output file + extCoreName :: String, -- name of the .core output file + verbosity :: Int, -- verbosity level + optLevel :: Int, -- optimisation level + simplPhases :: Int, -- number of simplifier phases + maxSimplIterations :: Int, -- max simplifier iterations + shouldDumpSimplPhase :: SimplifierMode -> Bool, + ruleCheck :: Maybe String, + + specConstrThreshold :: Maybe Int, -- Threshold for SpecConstr + specConstrCount :: Maybe Int, -- Max number of specialisations for any one function + liberateCaseThreshold :: Maybe Int, -- Threshold for LiberateCase + + stolen_x86_regs :: Int, + cmdlineHcIncludes :: [String], -- -#includes + importPaths :: [FilePath], + mainModIs :: Module, + mainFunIs :: Maybe String, + ctxtStkDepth :: Int, -- Typechecker context stack depth + + dphBackend :: DPHBackend, + + thisPackage :: PackageId, -- ways - wayNames :: [WayName], -- way flags from the cmd line - buildTag :: String, -- the global "way" (eg. "p" for prof) - rtsBuildTag :: String, -- the RTS "way" - + wayNames :: [WayName], -- way flags from the cmd line + buildTag :: String, -- the global "way" (eg. "p" for prof) + rtsBuildTag :: String, -- the RTS "way" + -- paths etc. - objectDir :: Maybe String, - hiDir :: Maybe String, - stubDir :: Maybe String, + objectDir :: Maybe String, + hiDir :: Maybe String, + stubDir :: Maybe String, - objectSuf :: String, - hcSuf :: String, - hiSuf :: String, + objectSuf :: String, + hcSuf :: String, + hiSuf :: String, - outputFile :: Maybe String, - outputHi :: Maybe String, + outputFile :: Maybe String, + outputHi :: Maybe String, + dynLibLoader :: DynLibLoader, -- | This is set by DriverPipeline.runPipeline based on where - -- its output is going. - dumpPrefix :: Maybe FilePath, + -- its output is going. + dumpPrefix :: Maybe FilePath, -- | Override the dumpPrefix set by runPipeline. - -- Set by -ddump-file-prefix - dumpPrefixForce :: Maybe FilePath, - - includePaths :: [String], - libraryPaths :: [String], - frameworkPaths :: [String], -- used on darwin only - cmdlineFrameworks :: [String], -- ditto - tmpDir :: String, -- no trailing '/' - + -- Set by -ddump-file-prefix + dumpPrefixForce :: Maybe FilePath, + + includePaths :: [String], + libraryPaths :: [String], + frameworkPaths :: [String], -- used on darwin only + cmdlineFrameworks :: [String], -- ditto + tmpDir :: String, -- no trailing '/' + ghcUsagePath :: FilePath, -- Filled in by SysTools ghciUsagePath :: FilePath, -- ditto - hpcDir :: String, -- ^ path to store the .mix files + hpcDir :: String, -- ^ path to store the .mix files -- options for particular phases - opt_L :: [String], - opt_P :: [String], - opt_F :: [String], - opt_c :: [String], - opt_m :: [String], - opt_a :: [String], - opt_l :: [String], - opt_dep :: [String], - opt_windres :: [String], + opt_L :: [String], + opt_P :: [String], + opt_F :: [String], + opt_c :: [String], + opt_m :: [String], + opt_a :: [String], + opt_l :: [String], + opt_dep :: [String], + opt_windres :: [String], -- commands for particular phases - pgm_L :: String, - pgm_P :: (String,[Option]), - pgm_F :: String, - pgm_c :: (String,[Option]), - pgm_m :: (String,[Option]), - pgm_s :: (String,[Option]), - pgm_a :: (String,[Option]), - pgm_l :: (String,[Option]), - pgm_dll :: (String,[Option]), + pgm_L :: String, + pgm_P :: (String,[Option]), + pgm_F :: String, + pgm_c :: (String,[Option]), + pgm_m :: (String,[Option]), + pgm_s :: (String,[Option]), + pgm_a :: (String,[Option]), + pgm_l :: (String,[Option]), + pgm_dll :: (String,[Option]), pgm_T :: String, pgm_sysman :: String, pgm_windres :: String, -- Package flags - extraPkgConfs :: [FilePath], + extraPkgConfs :: [FilePath], topDir :: FilePath, -- filled in by SysTools systemPackageConfig :: FilePath, -- ditto - -- The -package-conf flags given on the command line, in the order - -- they appeared. + -- The -package-conf flags given on the command line, in the order + -- they appeared. - packageFlags :: [PackageFlag], - -- The -package and -hide-package flags from the command-line + packageFlags :: [PackageFlag], + -- The -package and -hide-package flags from the command-line -- Package state - -- NB. do not modify this field, it is calculated by + -- NB. do not modify this field, it is calculated by -- Packages.initPackages and Packages.updatePackages. - pkgDatabase :: Maybe (UniqFM InstalledPackageInfo), - pkgState :: PackageState, + pkgDatabase :: Maybe (UniqFM PackageConfig), + pkgState :: PackageState, -- hsc dynamic flags - flags :: [DynFlag], - + flags :: [DynFlag], + -- message output - log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO () + log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (), + + haddockOptions :: Maybe String } data HscTarget @@ -404,7 +427,7 @@ isObjectTarget _ = False -- in order to check whether they need to be recompiled. data GhcMode = CompManager -- ^ --make, GHCi, etc. - | OneShot -- ^ ghc -c Foo.hs + | OneShot -- ^ ghc -c Foo.hs | MkDepend -- ^ ghc -M, see Finder for why we need this deriving Eq @@ -413,16 +436,16 @@ isOneShot OneShot = True isOneShot _other = False -- | What kind of linking to do. -data GhcLink -- What to do in the link step, if there is one - = NoLink -- Don't link at all - | LinkBinary -- Link object code into a binary +data GhcLink -- What to do in the link step, if there is one + = NoLink -- Don't link at all + | LinkBinary -- Link object code into a binary | LinkInMemory -- Use the in-memory dynamic linker - | LinkDynLib -- Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) - deriving Eq + | LinkDynLib -- Link objects into a dynamic lib (DLL on Windows, DSO on ELF platforms) + deriving (Eq, Show) isNoLink :: GhcLink -> Bool isNoLink NoLink = True -isNoLink other = False +isNoLink _ = False data PackageFlag = ExposePackage String @@ -430,116 +453,162 @@ data PackageFlag | IgnorePackage String deriving Eq +defaultHscTarget :: HscTarget defaultHscTarget = defaultObjectTarget -- | the 'HscTarget' value corresponding to the default way to create -- object files on the current platform. +defaultObjectTarget :: HscTarget defaultObjectTarget - | cGhcWithNativeCodeGen == "YES" = HscAsm - | otherwise = HscC + | cGhcWithNativeCodeGen == "YES" = HscAsm + | otherwise = HscC + +data DynLibLoader + = Deployable + | Wrapped (Maybe String) + | SystemDependent + deriving Eq +initDynFlags :: DynFlags -> IO DynFlags initDynFlags dflags = do -- someday these will be dynamic flags ways <- readIORef v_Ways build_tag <- readIORef v_Build_tag rts_build_tag <- readIORef v_RTS_Build_tag return dflags{ - wayNames = ways, - buildTag = build_tag, - rtsBuildTag = rts_build_tag - } + wayNames = ways, + buildTag = build_tag, + rtsBuildTag = rts_build_tag + } +defaultDynFlags :: DynFlags defaultDynFlags = DynFlags { - ghcMode = CompManager, - ghcLink = LinkBinary, - coreToDo = Nothing, - stgToDo = Nothing, - hscTarget = defaultHscTarget, - hscOutName = "", - extCoreName = "", - verbosity = 0, - optLevel = 0, - maxSimplIterations = 4, - ruleCheck = Nothing, - specThreshold = 200, - stolen_x86_regs = 4, - cmdlineHcIncludes = [], - importPaths = ["."], - mainModIs = mAIN, - mainFunIs = Nothing, - ctxtStkDepth = mAX_CONTEXT_REDUCTION_DEPTH, - - thisPackage = mainPackageId, - - objectDir = Nothing, - hiDir = Nothing, - stubDir = Nothing, - - objectSuf = phaseInputExt StopLn, - hcSuf = phaseInputExt HCc, - hiSuf = "hi", - - outputFile = Nothing, - outputHi = Nothing, - dumpPrefix = Nothing, - dumpPrefixForce = Nothing, - includePaths = [], - libraryPaths = [], - frameworkPaths = [], - cmdlineFrameworks = [], - tmpDir = cDEFAULT_TMPDIR, - - hpcDir = ".hpc", - - opt_L = [], - opt_P = (if opt_PIC - then ["-D__PIC__"] - else []), - opt_F = [], - opt_c = [], - opt_a = [], - opt_m = [], - opt_l = [], - opt_dep = [], + ghcMode = CompManager, + ghcLink = LinkBinary, + coreToDo = Nothing, + stgToDo = Nothing, + hscTarget = defaultHscTarget, + hscOutName = "", + extCoreName = "", + verbosity = 0, + optLevel = 0, + simplPhases = 2, + maxSimplIterations = 4, + shouldDumpSimplPhase = const False, + ruleCheck = Nothing, + specConstrThreshold = Just 200, + specConstrCount = Just 3, + liberateCaseThreshold = Just 200, + stolen_x86_regs = 4, + cmdlineHcIncludes = [], + importPaths = ["."], + mainModIs = mAIN, + mainFunIs = Nothing, + ctxtStkDepth = mAX_CONTEXT_REDUCTION_DEPTH, + + dphBackend = DPHPar, + + thisPackage = mainPackageId, + + objectDir = Nothing, + hiDir = Nothing, + stubDir = Nothing, + + objectSuf = phaseInputExt StopLn, + hcSuf = phaseInputExt HCc, + hiSuf = "hi", + + outputFile = Nothing, + outputHi = Nothing, + dynLibLoader = Deployable, + dumpPrefix = Nothing, + dumpPrefixForce = Nothing, + includePaths = [], + libraryPaths = [], + frameworkPaths = [], + cmdlineFrameworks = [], + tmpDir = cDEFAULT_TMPDIR, + + hpcDir = ".hpc", + + opt_L = [], + opt_P = (if opt_PIC + then ["-D__PIC__"] + else []), + opt_F = [], + opt_c = [], + opt_a = [], + opt_m = [], + opt_l = [], + opt_dep = [], opt_windres = [], - - extraPkgConfs = [], - packageFlags = [], + + extraPkgConfs = [], + packageFlags = [], pkgDatabase = Nothing, pkgState = panic "no package state yet: call GHC.setSessionDynFlags", - flags = [ - Opt_ReadUserPackageConf, - - Opt_MonoPatBinds, -- Experimentally, I'm making this non-standard - -- behaviour the default, to see if anyone notices - -- SLPJ July 06 - - Opt_ImplicitPrelude, - Opt_MonomorphismRestriction, - - Opt_DoAsmMangling, - + wayNames = panic "defaultDynFlags: No wayNames", + buildTag = panic "defaultDynFlags: No buildTag", + rtsBuildTag = panic "defaultDynFlags: No rtsBuildTag", + -- initSysTools fills all these in + ghcUsagePath = panic "defaultDynFlags: No ghciUsagePath", + ghciUsagePath = panic "defaultDynFlags: No ghciUsagePath", + topDir = panic "defaultDynFlags: No topDir", + systemPackageConfig = panic "defaultDynFlags: No systemPackageConfig", + pgm_L = panic "defaultDynFlags: No pgm_L", + pgm_P = panic "defaultDynFlags: No pgm_P", + pgm_F = panic "defaultDynFlags: No pgm_F", + pgm_c = panic "defaultDynFlags: No pgm_c", + pgm_m = panic "defaultDynFlags: No pgm_m", + pgm_s = panic "defaultDynFlags: No pgm_s", + pgm_a = panic "defaultDynFlags: No pgm_a", + pgm_l = panic "defaultDynFlags: No pgm_l", + pgm_dll = panic "defaultDynFlags: No pgm_dll", + pgm_T = panic "defaultDynFlags: No pgm_T", + pgm_sysman = panic "defaultDynFlags: No pgm_sysman", + pgm_windres = panic "defaultDynFlags: No pgm_windres", + -- end of initSysTools values + haddockOptions = Nothing, + flags = [ + Opt_AutoLinkPackages, + Opt_ReadUserPackageConf, + + Opt_MonoPatBinds, -- Experimentally, I'm making this non-standard + -- behaviour the default, to see if anyone notices + -- SLPJ July 06 + + Opt_ImplicitPrelude, + Opt_MonomorphismRestriction, + + Opt_MethodSharing, + + Opt_DoAsmMangling, + Opt_GenManifest, Opt_EmbedManifest, + Opt_PrintBindContents + ] + ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] + -- The default -O0 options + ++ standardWarnings, - -- on by default: - Opt_PrintBindResult ] - ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] - -- The default -O0 options - ++ standardWarnings, - - log_action = \severity srcSpan style msg -> + 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. } -{- +{- Verbosity levels: - - 0 | print errors & warnings only + + 0 | print errors & warnings only 1 | minimal verbosity: print "compiling M ... done." for each module. 2 | equivalent to -dshow-passes 3 | equivalent to existing "ghc -v" @@ -558,16 +627,26 @@ dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) } getOpts :: DynFlags -> (DynFlags -> [a]) -> [a] getOpts dflags opts = reverse (opts dflags) - -- We add to the options from the front, so we need to reverse the list + -- We add to the options from the front, so we need to reverse the list getVerbFlag :: DynFlags -> String -getVerbFlag dflags - | verbosity dflags >= 3 = "-v" +getVerbFlag dflags + | verbosity dflags >= 3 = "-v" | otherwise = "" -setObjectDir f d = d{ objectDir = f} -setHiDir f d = d{ hiDir = f} -setStubDir f d = d{ stubDir = f} +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, + addCmdlineFramework, addHaddockOpts + :: String -> DynFlags -> DynFlags +setOutputFile, setOutputHi, setDumpPrefixForce + :: Maybe String -> DynFlags -> DynFlags + +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. setObjectSuf f d = d{ objectSuf = f} setHiSuf f d = d{ hiSuf = f} @@ -576,6 +655,15 @@ setHcSuf f d = d{ hcSuf = f} setOutputFile f d = d{ outputFile = f} setOutputHi f d = d{ outputHi = f} +parseDynLibLoaderMode f d = + case splitAt 8 f of + ("deploy", "") -> d{ dynLibLoader = Deployable } + ("sysdep", "") -> d{ dynLibLoader = SystemDependent } + ("wrapped", "") -> d{ dynLibLoader = Wrapped Nothing } + ("wrapped:", "hard") -> d{ dynLibLoader = Wrapped Nothing } + ("wrapped:", flex) -> d{ dynLibLoader = Wrapped (Just flex) } + (_,_) -> error "Unknown dynlib loader" + setDumpPrefixForce f d = d { dumpPrefixForce = f} -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"] @@ -604,6 +692,8 @@ addOptwindres f d = d{ opt_windres = f : opt_windres d} addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d} +addHaddockOpts f d = d{ haddockOptions = Just f} + -- ----------------------------------------------------------------------------- -- Command-line options @@ -616,11 +706,11 @@ addCmdlineFramework f d = d{ cmdlineFrameworks = f : cmdlineFrameworks d} data Option = FileOption -- an entry that _contains_ filename(s) / filepaths. - String -- a non-filepath prefix that shouldn't be - -- transformed (e.g., "/out=") - String -- the filepath/filename portion + String -- a non-filepath prefix that shouldn't be + -- transformed (e.g., "/out=") + String -- the filepath/filename portion | Option String - + ----------------------------------------------------------------------------- -- Setting the optimisation level @@ -629,67 +719,74 @@ updOptLevel :: Int -> DynFlags -> DynFlags updOptLevel n dfs = dfs2{ optLevel = final_n } where - final_n = max 0 (min 2 n) -- Clamp to 0 <= n <= 2 + final_n = max 0 (min 2 n) -- Clamp to 0 <= n <= 2 dfs1 = foldr (flip dopt_unset) dfs remove_dopts dfs2 = foldr (flip dopt_set) dfs1 extra_dopts extra_dopts = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ] remove_dopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ] - + optLevelFlags :: [([Int], DynFlag)] optLevelFlags - = [ ([0], Opt_IgnoreInterfacePragmas) + = [ ([0], Opt_IgnoreInterfacePragmas) , ([0], Opt_OmitInterfacePragmas) - , ([1,2], Opt_IgnoreAsserts) - , ([1,2], Opt_RewriteRules) -- Off for -O0; see Note [Scoping for Builtin rules] - -- in PrelRules - , ([1,2], Opt_DoEtaReduction) - , ([1,2], Opt_CaseMerge) - , ([1,2], Opt_Strictness) - , ([1,2], Opt_CSE) - , ([1,2], Opt_FullLaziness) + , ([1,2], Opt_IgnoreAsserts) + , ([1,2], Opt_RewriteRules) -- Off for -O0; see Note [Scoping for Builtin rules] + -- in PrelRules + , ([1,2], Opt_DoEtaReduction) + , ([1,2], Opt_CaseMerge) + , ([1,2], Opt_Strictness) + , ([1,2], Opt_CSE) + , ([1,2], Opt_FullLaziness) - , ([2], Opt_LiberateCase) - , ([2], Opt_SpecConstr) + , ([2], Opt_LiberateCase) + , ([2], Opt_SpecConstr) + , ([2], Opt_StaticArgumentTransformation) , ([0,1,2], Opt_DoLambdaEtaExpansion) - -- This one is important for a tiresome reason: - -- we want to make sure that the bindings for data - -- constructors are eta-expanded. This is probably - -- a good thing anyway, but it seems fragile. + -- This one is important for a tiresome reason: + -- we want to make sure that the bindings for data + -- constructors are eta-expanded. This is probably + -- a good thing anyway, but it seems fragile. ] -- ----------------------------------------------------------------------------- -- Standard sets of warning options +standardWarnings :: [DynFlag] standardWarnings - = [ Opt_WarnDeprecations, - Opt_WarnOverlappingPatterns, - Opt_WarnMissingFields, - Opt_WarnMissingMethods, - Opt_WarnDuplicateExports + = [ Opt_WarnWarningsDeprecations, + Opt_WarnDeprecatedFlags, + Opt_WarnOverlappingPatterns, + Opt_WarnMissingFields, + Opt_WarnMissingMethods, + Opt_WarnDuplicateExports, + Opt_WarnDodgyForeignImports ] +minusWOpts :: [DynFlag] minusWOpts - = standardWarnings ++ - [ Opt_WarnUnusedBinds, - Opt_WarnUnusedMatches, - Opt_WarnUnusedImports, - Opt_WarnIncompletePatterns, - Opt_WarnDodgyImports + = standardWarnings ++ + [ Opt_WarnUnusedBinds, + Opt_WarnUnusedMatches, + Opt_WarnUnusedImports, + Opt_WarnIncompletePatterns, + Opt_WarnDodgyImports ] +minusWallOpts :: [DynFlag] minusWallOpts = minusWOpts ++ - [ Opt_WarnTypeDefaults, - Opt_WarnNameShadowing, - Opt_WarnMissingSigs, - Opt_WarnHiShadows, - Opt_WarnOrphans + [ Opt_WarnTypeDefaults, + Opt_WarnNameShadowing, + Opt_WarnMissingSigs, + Opt_WarnHiShadows, + Opt_WarnOrphans ] -- minuswRemovesOpts should be every warning option +minuswRemovesOpts :: [DynFlag] minuswRemovesOpts = minusWallOpts ++ [Opt_WarnImplicitPrelude, @@ -702,15 +799,15 @@ minuswRemovesOpts -- ----------------------------------------------------------------------------- -- CoreToDo: abstraction of core-to-core passes to run. -data CoreToDo -- These are diff core-to-core passes, - -- which may be invoked in any order, - -- as many times as you like. +data CoreToDo -- These are diff core-to-core passes, + -- which may be invoked in any order, + -- as many times as you like. - = CoreDoSimplify -- The core-to-core simplifier. - SimplifierMode - [SimplifierSwitch] - -- Each run of the simplifier can take a different - -- set of simplifier-specific flags. + = CoreDoSimplify -- The core-to-core simplifier. + SimplifierMode + [SimplifierSwitch] + -- Each run of the simplifier can take a different + -- set of simplifier-specific flags. | CoreDoFloatInwards | CoreDoFloatOutwards FloatOutSwitches | CoreLiberateCase @@ -723,169 +820,184 @@ data CoreToDo -- These are diff core-to-core passes, | CoreDoOldStrictness | CoreDoGlomBinds | CoreCSE - | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules - -- matching this string - | CoreDoVectorisation - | CoreDoNothing -- Useful when building up - | CoreDoPasses [CoreToDo] -- lists of these things + | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules + -- matching this string + | CoreDoVectorisation DPHBackend + | CoreDoNothing -- Useful when building up + | CoreDoPasses [CoreToDo] -- lists of these things -data SimplifierMode -- See comments in SimplMonad +data SimplifierMode -- See comments in SimplMonad = SimplGently - | SimplPhase Int + | SimplPhase Int [String] data SimplifierSwitch = MaxSimplifierIterations Int | NoCaseOfCase data FloatOutSwitches - = FloatOutSw Bool -- True <=> float lambdas to top level - Bool -- True <=> float constants to top level, - -- even if they do not escape a lambda + = FloatOutSw Bool -- True <=> float lambdas to top level + Bool -- True <=> float constants to top level, + -- even if they do not escape a lambda -- The core-to-core pass ordering is derived from the DynFlags: runWhen :: Bool -> CoreToDo -> CoreToDo runWhen True do_this = do_this -runWhen False do_this = CoreDoNothing +runWhen False _ = CoreDoNothing + +runMaybe :: Maybe a -> (a -> CoreToDo) -> CoreToDo +runMaybe (Just x) f = f x +runMaybe Nothing _ = CoreDoNothing getCoreToDo :: DynFlags -> [CoreToDo] getCoreToDo dflags | Just todo <- coreToDo dflags = todo -- set explicitly by user | otherwise = core_todo where - opt_level = optLevel dflags - max_iter = maxSimplIterations dflags + opt_level = optLevel dflags + phases = simplPhases dflags + max_iter = maxSimplIterations dflags strictness = dopt Opt_Strictness dflags full_laziness = dopt Opt_FullLaziness dflags cse = dopt Opt_CSE dflags spec_constr = dopt Opt_SpecConstr dflags liberate_case = dopt Opt_LiberateCase dflags rule_check = ruleCheck dflags - vectorisation = dopt Opt_Vectorise dflags - - core_todo = + static_args = dopt Opt_StaticArgumentTransformation dflags + + maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase) + + simpl_phase phase names iter + = CoreDoPasses + [ CoreDoSimplify (SimplPhase phase names) [ + MaxSimplifierIterations iter + ], + maybe_rule_check phase + ] + + vectorisation + = runWhen (dopt Opt_Vectorise dflags) + $ CoreDoPasses [ simpl_gently, CoreDoVectorisation (dphBackend dflags) ] + + + -- By default, we have 2 phases before phase 0. + + -- Want to run with inline phase 2 after the specialiser to give + -- maximum chance for fusion to work before we inline build/augment + -- in phase 1. This made a difference in 'ansi' where an + -- overloaded function wasn't inlined till too late. + + -- Need phase 1 so that build/augment get + -- inlined. I found that spectral/hartel/genfft lost some useful + -- strictness in the function sumcode' if augment is not inlined + -- before strictness analysis runs + simpl_phases = CoreDoPasses [ simpl_phase phase ["main"] max_iter + | phase <- [phases, phases-1 .. 1] ] + + + -- initial simplify: mk specialiser happy: minimum effort please + simpl_gently = CoreDoSimplify SimplGently [ + -- Simplify "gently" + -- Don't inline anything till full laziness has bitten + -- In particular, inlining wrappers inhibits floating + -- e.g. ...(case f x of ...)... + -- ==> ...(case (case x of I# x# -> fw x#) of ...)... + -- ==> ...(case x of I# x# -> case fw x# of ...)... + -- and now the redex (f x) isn't floatable any more + -- Similarly, don't apply any rules until after full + -- laziness. Notably, list fusion can prevent floating. + + NoCaseOfCase, -- Don't do case-of-case transformations. + -- This makes full laziness work better + MaxSimplifierIterations max_iter + ] + + core_todo = if opt_level == 0 then - [ - CoreDoSimplify (SimplPhase 0) [ - MaxSimplifierIterations max_iter - ] - ] - else {- opt_level >= 1 -} [ - - -- initial simplify: mk specialiser happy: minimum effort please - CoreDoSimplify SimplGently [ - -- Simplify "gently" - -- Don't inline anything till full laziness has bitten - -- In particular, inlining wrappers inhibits floating - -- e.g. ...(case f x of ...)... - -- ==> ...(case (case x of I# x# -> fw x#) of ...)... - -- ==> ...(case x of I# x# -> case fw x# of ...)... - -- and now the redex (f x) isn't floatable any more - -- Similarly, don't apply any rules until after full - -- laziness. Notably, list fusion can prevent floating. - - NoCaseOfCase, -- Don't do case-of-case transformations. - -- This makes full laziness work better - MaxSimplifierIterations max_iter - ], + [vectorisation, + simpl_phase 0 ["final"] max_iter] + else {- opt_level >= 1 -} [ + -- We want to do the static argument transform before full laziness as it + -- may expose extra opportunities to float things outwards. However, to fix + -- up the output of the transformation we need at do at least one simplify + -- after this before anything else + runWhen static_args (CoreDoPasses [ simpl_gently, CoreDoStaticArgs ]), -- We run vectorisation here for now, but we might also try to run -- it later - runWhen vectorisation (CoreDoPasses [ - CoreDoVectorisation, - CoreDoSimplify SimplGently - [NoCaseOfCase, - MaxSimplifierIterations max_iter]]), - - -- Specialisation is best done before full laziness - -- so that overloaded functions have all their dictionary lambdas manifest - CoreDoSpecialising, - - runWhen full_laziness (CoreDoFloatOutwards (FloatOutSw False False)), - - CoreDoFloatInwards, - - CoreDoSimplify (SimplPhase 2) [ - -- Want to run with inline phase 2 after the specialiser to give - -- maximum chance for fusion to work before we inline build/augment - -- in phase 1. This made a difference in 'ansi' where an - -- overloaded function wasn't inlined till too late. - MaxSimplifierIterations max_iter - ], - case rule_check of { Just pat -> CoreDoRuleCheck 2 pat; Nothing -> CoreDoNothing }, - - CoreDoSimplify (SimplPhase 1) [ - -- Need inline-phase2 here so that build/augment get - -- inlined. I found that spectral/hartel/genfft lost some useful - -- strictness in the function sumcode' if augment is not inlined - -- before strictness analysis runs - MaxSimplifierIterations max_iter - ], - case rule_check of { Just pat -> CoreDoRuleCheck 1 pat; Nothing -> CoreDoNothing }, - - CoreDoSimplify (SimplPhase 0) [ - -- Phase 0: allow all Ids to be inlined now - -- This gets foldr inlined before strictness analysis - - MaxSimplifierIterations 3 - -- At least 3 iterations because otherwise we land up with - -- huge dead expressions because of an infelicity in the - -- simpifier. - -- let k = BIG in foldr k z xs - -- ==> let k = BIG in letrec go = \xs -> ...(k x).... in go xs - -- ==> let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs - -- Don't stop now! - - ], - case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing }, + vectorisation, + + -- initial simplify: mk specialiser happy: minimum effort please + simpl_gently, + + -- Specialisation is best done before full laziness + -- so that overloaded functions have all their dictionary lambdas manifest + CoreDoSpecialising, + + runWhen full_laziness (CoreDoFloatOutwards (FloatOutSw False False)), + + CoreDoFloatInwards, + + simpl_phases, + + -- Phase 0: allow all Ids to be inlined now + -- This gets foldr inlined before strictness analysis + + -- At least 3 iterations because otherwise we land up with + -- huge dead expressions because of an infelicity in the + -- simpifier. + -- let k = BIG in foldr k z xs + -- ==> let k = BIG in letrec go = \xs -> ...(k x).... in go xs + -- ==> let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs + -- Don't stop now! + simpl_phase 0 ["main"] (max max_iter 3), + #ifdef OLD_STRICTNESS - CoreDoOldStrictness, + CoreDoOldStrictness, #endif - runWhen strictness (CoreDoPasses [ - CoreDoStrictness, - CoreDoWorkerWrapper, - CoreDoGlomBinds, - CoreDoSimplify (SimplPhase 0) [ - MaxSimplifierIterations max_iter - ]]), - - runWhen full_laziness - (CoreDoFloatOutwards (FloatOutSw False -- Not lambdas - True)), -- Float constants - -- nofib/spectral/hartel/wang doubles in speed if you - -- do full laziness late in the day. It only happens - -- after fusion and other stuff, so the early pass doesn't - -- catch it. For the record, the redex is - -- f_el22 (f_el21 r_midblock) - - - runWhen cse CoreCSE, - -- We want CSE to follow the final full-laziness pass, because it may - -- succeed in commoning up things floated out by full laziness. - -- CSE used to rely on the no-shadowing invariant, but it doesn't any more - - CoreDoFloatInwards, - - case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing }, - - -- Case-liberation for -O2. This should be after - -- strictness analysis and the simplification which follows it. - runWhen liberate_case (CoreDoPasses [ - CoreLiberateCase, - CoreDoSimplify (SimplPhase 0) [ - MaxSimplifierIterations max_iter - ] ]), -- Run the simplifier after LiberateCase to vastly - -- reduce the possiblility of shadowing - -- Reason: see Note [Shadowing] in SpecConstr.lhs - - runWhen spec_constr CoreDoSpecConstr, - - -- Final clean-up simplification: - CoreDoSimplify (SimplPhase 0) [ - MaxSimplifierIterations max_iter - ] + runWhen strictness (CoreDoPasses [ + CoreDoStrictness, + CoreDoWorkerWrapper, + CoreDoGlomBinds, + simpl_phase 0 ["post-worker-wrapper"] max_iter + ]), + + runWhen full_laziness + (CoreDoFloatOutwards (FloatOutSw False -- Not lambdas + True)), -- Float constants + -- nofib/spectral/hartel/wang doubles in speed if you + -- do full laziness late in the day. It only happens + -- after fusion and other stuff, so the early pass doesn't + -- catch it. For the record, the redex is + -- f_el22 (f_el21 r_midblock) + + + runWhen cse CoreCSE, + -- We want CSE to follow the final full-laziness pass, because it may + -- succeed in commoning up things floated out by full laziness. + -- CSE used to rely on the no-shadowing invariant, but it doesn't any more + + CoreDoFloatInwards, + + maybe_rule_check 0, + + -- Case-liberation for -O2. This should be after + -- strictness analysis and the simplification which follows it. + runWhen liberate_case (CoreDoPasses [ + CoreLiberateCase, + simpl_phase 0 ["post-liberate-case"] max_iter + ]), -- Run the simplifier after LiberateCase to vastly + -- reduce the possiblility of shadowing + -- Reason: see Note [Shadowing] in SpecConstr.lhs + + runWhen spec_constr CoreDoSpecConstr, + + maybe_rule_check 0, + + -- Final clean-up simplification: + simpl_phase 0 ["final"] max_iter ] -- ----------------------------------------------------------------------------- @@ -902,396 +1014,556 @@ getStgToDo dflags | Just todo <- stgToDo dflags = todo -- set explicitly by user | otherwise = todo2 where - stg_stats = dopt Opt_StgStats dflags + stg_stats = dopt Opt_StgStats dflags - todo1 = if stg_stats then [D_stg_stats] else [] + todo1 = if stg_stats then [D_stg_stats] else [] - todo2 | WayProf `elem` wayNames dflags - = StgDoMassageForProfiling : todo1 - | otherwise - = todo1 + todo2 | WayProf `elem` wayNames dflags + = StgDoMassageForProfiling : todo1 + | otherwise + = todo1 -- ----------------------------------------------------------------------------- -- DynFlags parser allFlags :: [String] allFlags = map ('-':) $ - [ name | (name, optkind) <- dynamic_flags, ok optkind ] ++ + [ flagName flag | flag <- dynamic_flags, ok (flagOptKind flag) ] ++ map ("fno-"++) flags ++ - map ("f"++) flags + map ("f"++) flags ++ + map ("X"++) supportedLanguages ++ + map ("XNo"++) supportedLanguages where ok (PrefixPred _ _) = False ok _ = True - flags = map fst fFlags + flags = [ name | (name, _, _) <- fFlags ] -dynamic_flags :: [(String, OptKind DynP)] +dynamic_flags :: [Flag DynP] dynamic_flags = [ - ( "n" , NoArg (setDynFlag Opt_DryRun) ) - , ( "cpp" , NoArg (setDynFlag Opt_Cpp)) - , ( "F" , NoArg (setDynFlag Opt_Pp)) - , ( "#include" , HasArg (addCmdlineHCInclude) ) - , ( "v" , OptIntSuffix setVerbosity ) + Flag "n" (NoArg (setDynFlag Opt_DryRun)) Supported + , Flag "cpp" (NoArg (setDynFlag Opt_Cpp)) Supported + , Flag "F" (NoArg (setDynFlag Opt_Pp)) Supported + , Flag "#include" (HasArg (addCmdlineHCInclude)) Supported + , Flag "v" (OptIntSuffix setVerbosity) Supported ------- Specific phases -------------------------------------------- - , ( "pgmL" , HasArg (upd . setPgmL) ) - , ( "pgmP" , HasArg (upd . setPgmP) ) - , ( "pgmF" , HasArg (upd . setPgmF) ) - , ( "pgmc" , HasArg (upd . setPgmc) ) - , ( "pgmm" , HasArg (upd . setPgmm) ) - , ( "pgms" , HasArg (upd . setPgms) ) - , ( "pgma" , HasArg (upd . setPgma) ) - , ( "pgml" , HasArg (upd . setPgml) ) - , ( "pgmdll" , HasArg (upd . setPgmdll) ) - , ( "pgmwindres" , HasArg (upd . setPgmwindres) ) - - , ( "optL" , HasArg (upd . addOptL) ) - , ( "optP" , HasArg (upd . addOptP) ) - , ( "optF" , HasArg (upd . addOptF) ) - , ( "optc" , HasArg (upd . addOptc) ) - , ( "optm" , HasArg (upd . addOptm) ) - , ( "opta" , HasArg (upd . addOpta) ) - , ( "optl" , HasArg (upd . addOptl) ) - , ( "optdep" , HasArg (upd . addOptdep) ) - , ( "optwindres" , HasArg (upd . addOptwindres) ) - - , ( "split-objs" , NoArg (if can_split - then setDynFlag Opt_SplitObjs - else return ()) ) - - -------- Linking ---------------------------------------------------- - , ( "c" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) - , ( "no-link" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) -- Dep. - , ( "shared" , NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } )) - - ------- Libraries --------------------------------------------------- - , ( "L" , Prefix addLibraryPath ) - , ( "l" , AnySuffix (\s -> do upd (addOptl s))) - - ------- Frameworks -------------------------------------------------- + , Flag "pgmL" (HasArg (upd . setPgmL)) Supported + , Flag "pgmP" (HasArg (upd . setPgmP)) Supported + , Flag "pgmF" (HasArg (upd . setPgmF)) Supported + , Flag "pgmc" (HasArg (upd . setPgmc)) Supported + , Flag "pgmm" (HasArg (upd . setPgmm)) Supported + , Flag "pgms" (HasArg (upd . setPgms)) Supported + , Flag "pgma" (HasArg (upd . setPgma)) Supported + , Flag "pgml" (HasArg (upd . setPgml)) Supported + , Flag "pgmdll" (HasArg (upd . setPgmdll)) Supported + , Flag "pgmwindres" (HasArg (upd . setPgmwindres)) Supported + + , Flag "optL" (HasArg (upd . addOptL)) Supported + , Flag "optP" (HasArg (upd . addOptP)) Supported + , Flag "optF" (HasArg (upd . addOptF)) Supported + , Flag "optc" (HasArg (upd . addOptc)) 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 + + -------- Linking ---------------------------------------------------- + , Flag "c" (NoArg (upd $ \d -> d{ ghcLink=NoLink } )) + Supported + , Flag "no-link" (NoArg (upd $ \d -> d{ ghcLink=NoLink } )) + (Deprecated "Use -c instead") + , Flag "shared" (NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } )) + Supported + , Flag "dynload" (HasArg (upd . parseDynLibLoaderMode)) + Supported + + ------- Libraries --------------------------------------------------- + , Flag "L" (Prefix addLibraryPath ) Supported + , Flag "l" (AnySuffix (\s -> do upd (addOptl s))) Supported + + ------- Frameworks -------------------------------------------------- -- -framework-path should really be -F ... - , ( "framework-path" , HasArg addFrameworkPath ) - , ( "framework" , HasArg (upd . addCmdlineFramework) ) - - ------- Output Redirection ------------------------------------------ - , ( "odir" , HasArg (upd . setObjectDir . Just)) - , ( "o" , SepArg (upd . setOutputFile . Just)) - , ( "ohi" , HasArg (upd . setOutputHi . Just )) - , ( "osuf" , HasArg (upd . setObjectSuf)) - , ( "hcsuf" , HasArg (upd . setHcSuf)) - , ( "hisuf" , HasArg (upd . setHiSuf)) - , ( "hidir" , HasArg (upd . setHiDir . Just)) - , ( "tmpdir" , HasArg (upd . setTmpDir)) - , ( "stubdir" , HasArg (upd . setStubDir . Just)) - , ( "ddump-file-prefix", HasArg (upd . setDumpPrefixForce . Just)) - - ------- Keeping temporary files ------------------------------------- + , Flag "framework-path" (HasArg addFrameworkPath ) Supported + , Flag "framework" (HasArg (upd . addCmdlineFramework)) Supported + + ------- Output Redirection ------------------------------------------ + , Flag "odir" (HasArg (upd . setObjectDir)) Supported + , Flag "o" (SepArg (upd . setOutputFile . Just)) Supported + , Flag "ohi" (HasArg (upd . setOutputHi . Just )) Supported + , Flag "osuf" (HasArg (upd . setObjectSuf)) Supported + , Flag "hcsuf" (HasArg (upd . setHcSuf)) Supported + , Flag "hisuf" (HasArg (upd . setHiSuf)) Supported + , Flag "hidir" (HasArg (upd . setHiDir)) Supported + , Flag "tmpdir" (HasArg (upd . setTmpDir)) Supported + , Flag "stubdir" (HasArg (upd . setStubDir)) Supported + , Flag "ddump-file-prefix" (HasArg (upd . setDumpPrefixForce . Just)) + Supported + + ------- Keeping temporary files ------------------------------------- -- These can be singular (think ghc -c) or plural (think ghc --make) - , ( "keep-hc-file" , NoArg (setDynFlag Opt_KeepHcFiles)) - , ( "keep-hc-files" , NoArg (setDynFlag Opt_KeepHcFiles)) - , ( "keep-s-file" , NoArg (setDynFlag Opt_KeepSFiles)) - , ( "keep-s-files" , NoArg (setDynFlag Opt_KeepSFiles)) - , ( "keep-raw-s-file" , NoArg (setDynFlag Opt_KeepRawSFiles)) - , ( "keep-raw-s-files", NoArg (setDynFlag Opt_KeepRawSFiles)) + , Flag "keep-hc-file" (NoArg (setDynFlag Opt_KeepHcFiles)) Supported + , Flag "keep-hc-files" (NoArg (setDynFlag Opt_KeepHcFiles)) Supported + , Flag "keep-s-file" (NoArg (setDynFlag Opt_KeepSFiles)) Supported + , Flag "keep-s-files" (NoArg (setDynFlag Opt_KeepSFiles)) Supported + , Flag "keep-raw-s-file" (NoArg (setDynFlag Opt_KeepRawSFiles)) Supported + , Flag "keep-raw-s-files" (NoArg (setDynFlag Opt_KeepRawSFiles)) Supported -- This only makes sense as plural - , ( "keep-tmp-files" , NoArg (setDynFlag Opt_KeepTmpFiles)) - - ------- Miscellaneous ---------------------------------------------- - , ( "no-hs-main" , NoArg (setDynFlag Opt_NoHsMain)) - , ( "main-is" , SepArg setMainIs ) - , ( "haddock" , NoArg (setDynFlag Opt_Haddock) ) - , ( "hpcdir" , SepArg setOptHpcDir ) - - ------- recompilation checker (DEPRECATED, use -fforce-recomp) ----- - , ( "recomp" , NoArg (unSetDynFlag Opt_ForceRecomp) ) - , ( "no-recomp" , NoArg (setDynFlag Opt_ForceRecomp) ) + , Flag "keep-tmp-files" (NoArg (setDynFlag Opt_KeepTmpFiles)) Supported + + ------- Miscellaneous ---------------------------------------------- + , Flag "no-auto-link-packages" (NoArg (unSetDynFlag Opt_AutoLinkPackages)) Supported + , Flag "no-hs-main" (NoArg (setDynFlag Opt_NoHsMain)) Supported + , Flag "main-is" (SepArg setMainIs ) Supported + , Flag "haddock" (NoArg (setDynFlag Opt_Haddock)) Supported + , Flag "haddock-opts" (HasArg (upd . addHaddockOpts)) Supported + , Flag "hpcdir" (SepArg setOptHpcDir) Supported + + ------- recompilation checker -------------------------------------- + , Flag "recomp" (NoArg (unSetDynFlag Opt_ForceRecomp)) + (Deprecated "Use -fno-force-recomp instead") + , Flag "no-recomp" (NoArg (setDynFlag Opt_ForceRecomp)) + (Deprecated "Use -fforce-recomp instead") ------- Packages ---------------------------------------------------- - , ( "package-conf" , HasArg extraPkgConf_ ) - , ( "no-user-package-conf", NoArg (unSetDynFlag Opt_ReadUserPackageConf) ) - , ( "package-name" , HasArg (upd . setPackageName) ) - , ( "package" , HasArg exposePackage ) - , ( "hide-package" , HasArg hidePackage ) - , ( "hide-all-packages", NoArg (setDynFlag Opt_HideAllPackages) ) - , ( "ignore-package" , HasArg ignorePackage ) - , ( "syslib" , HasArg exposePackage ) -- for compatibility - - ------ HsCpp opts --------------------------------------------------- - , ( "D", AnySuffix (upd . addOptP) ) - , ( "U", AnySuffix (upd . addOptP) ) - - ------- Include/Import Paths ---------------------------------------- - , ( "I" , Prefix addIncludePath) - , ( "i" , OptPrefix addImportPath ) - - ------ Debugging ---------------------------------------------------- - , ( "dstg-stats", NoArg (setDynFlag Opt_StgStats)) - - , ( "ddump-cmm", setDumpFlag Opt_D_dump_cmm) - , ( "ddump-cps-cmm", setDumpFlag Opt_D_dump_cps_cmm) - , ( "ddump-asm", setDumpFlag Opt_D_dump_asm) - , ( "ddump-asm-native", setDumpFlag Opt_D_dump_asm_native) - , ( "ddump-asm-liveness", setDumpFlag Opt_D_dump_asm_liveness) - , ( "ddump-asm-coalesce", setDumpFlag Opt_D_dump_asm_coalesce) - , ( "ddump-asm-regalloc", setDumpFlag Opt_D_dump_asm_regalloc) - , ( "ddump-asm-conflicts", setDumpFlag Opt_D_dump_asm_conflicts) - , ( "ddump-asm-regalloc-stages", - setDumpFlag Opt_D_dump_asm_regalloc_stages) - , ( "ddump-asm-stats", setDumpFlag Opt_D_dump_asm_stats) - , ( "ddump-cpranal", setDumpFlag Opt_D_dump_cpranal) - , ( "ddump-deriv", setDumpFlag Opt_D_dump_deriv) - , ( "ddump-ds", setDumpFlag Opt_D_dump_ds) - , ( "ddump-flatC", setDumpFlag Opt_D_dump_flatC) - , ( "ddump-foreign", setDumpFlag Opt_D_dump_foreign) - , ( "ddump-inlinings", setDumpFlag Opt_D_dump_inlinings) - , ( "ddump-rule-firings", setDumpFlag Opt_D_dump_rule_firings) - , ( "ddump-occur-anal", setDumpFlag Opt_D_dump_occur_anal) - , ( "ddump-parsed", setDumpFlag Opt_D_dump_parsed) - , ( "ddump-rn", setDumpFlag Opt_D_dump_rn) - , ( "ddump-simpl", setDumpFlag Opt_D_dump_simpl) - , ( "ddump-simpl-iterations", setDumpFlag Opt_D_dump_simpl_iterations) - , ( "ddump-spec", setDumpFlag Opt_D_dump_spec) - , ( "ddump-prep", setDumpFlag Opt_D_dump_prep) - , ( "ddump-stg", setDumpFlag Opt_D_dump_stg) - , ( "ddump-stranal", setDumpFlag Opt_D_dump_stranal) - , ( "ddump-tc", setDumpFlag Opt_D_dump_tc) - , ( "ddump-types", setDumpFlag Opt_D_dump_types) - , ( "ddump-rules", setDumpFlag Opt_D_dump_rules) - , ( "ddump-cse", setDumpFlag Opt_D_dump_cse) - , ( "ddump-worker-wrapper", setDumpFlag Opt_D_dump_worker_wrapper) - , ( "ddump-rn-trace", setDumpFlag Opt_D_dump_rn_trace) - , ( "ddump-if-trace", setDumpFlag Opt_D_dump_if_trace) - , ( "ddump-tc-trace", setDumpFlag Opt_D_dump_tc_trace) - , ( "ddump-splices", setDumpFlag Opt_D_dump_splices) - , ( "ddump-rn-stats", setDumpFlag Opt_D_dump_rn_stats) - , ( "ddump-opt-cmm", setDumpFlag Opt_D_dump_opt_cmm) - , ( "ddump-simpl-stats", setDumpFlag Opt_D_dump_simpl_stats) - , ( "ddump-bcos", setDumpFlag Opt_D_dump_BCOs) - , ( "dsource-stats", setDumpFlag Opt_D_source_stats) - , ( "dverbose-core2core", setDumpFlag Opt_D_verbose_core2core) - , ( "dverbose-stg2stg", setDumpFlag Opt_D_verbose_stg2stg) - , ( "ddump-hi", setDumpFlag Opt_D_dump_hi) - , ( "ddump-minimal-imports", setDumpFlag Opt_D_dump_minimal_imports) - , ( "ddump-vect", setDumpFlag Opt_D_dump_vect) - , ( "ddump-hpc", setDumpFlag Opt_D_dump_hpc) - , ( "ddump-mod-cycles", setDumpFlag Opt_D_dump_mod_cycles) - , ( "ddump-to-file", setDumpFlag Opt_DumpToFile) - , ( "ddump-hi-diffs", NoArg (setDynFlag Opt_D_dump_hi_diffs)) - , ( "dcore-lint", NoArg (setDynFlag Opt_DoCoreLinting)) - , ( "dstg-lint", NoArg (setDynFlag Opt_DoStgLinting)) - , ( "dcmm-lint", NoArg (setDynFlag Opt_DoCmmLinting)) - , ( "dshow-passes", NoArg (do setDynFlag Opt_ForceRecomp - setVerbosity (Just 2)) ) - , ( "dfaststring-stats", NoArg (setDynFlag Opt_D_faststring_stats)) - - ------ Machine dependant (-m) stuff --------------------------- - - , ( "monly-2-regs", NoArg (upd (\s -> s{stolen_x86_regs = 2}) )) - , ( "monly-3-regs", NoArg (upd (\s -> s{stolen_x86_regs = 3}) )) - , ( "monly-4-regs", NoArg (upd (\s -> s{stolen_x86_regs = 4}) )) - - ------ Warning opts ------------------------------------------------- - , ( "W" , NoArg (mapM_ setDynFlag minusWOpts) ) - , ( "Werror" , NoArg (setDynFlag Opt_WarnIsError) ) - , ( "Wall" , NoArg (mapM_ setDynFlag minusWallOpts) ) - , ( "Wnot" , NoArg (mapM_ unSetDynFlag minusWallOpts) ) /* DEPREC */ - , ( "w" , NoArg (mapM_ unSetDynFlag minuswRemovesOpts) ) - - ------ Optimisation flags ------------------------------------------ - , ( "O" , NoArg (upd (setOptLevel 1))) - , ( "Onot" , NoArg (upd (setOptLevel 0))) -- deprecated - , ( "O" , OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1)))) - -- If the number is missing, use 1 - - , ( "fmax-simplifier-iterations", IntSuffix (\n -> - upd (\dfs -> dfs{ maxSimplIterations = n })) ) - - -- liberate-case-threshold is an old flag for '-fspec-threshold' - , ( "fspec-threshold", IntSuffix (\n -> upd (\dfs -> dfs{ specThreshold = n }))) - , ( "fliberate-case-threshold", IntSuffix (\n -> upd (\dfs -> dfs{ specThreshold = n }))) - - , ( "frule-check", SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s }))) - , ( "fcontext-stack" , IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n }) + , Flag "package-conf" (HasArg extraPkgConf_) Supported + , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf)) + Supported + , Flag "package-name" (HasArg (upd . setPackageName)) Supported + , Flag "package" (HasArg exposePackage) Supported + , Flag "hide-package" (HasArg hidePackage) Supported + , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages)) + Supported + , Flag "ignore-package" (HasArg ignorePackage) + Supported + , Flag "syslib" (HasArg exposePackage) + (Deprecated "Use -package instead") + + ------ HsCpp opts --------------------------------------------------- + , Flag "D" (AnySuffix (upd . addOptP)) Supported + , Flag "U" (AnySuffix (upd . addOptP)) Supported + + ------- Include/Import Paths ---------------------------------------- + , Flag "I" (Prefix addIncludePath) Supported + , Flag "i" (OptPrefix addImportPath ) Supported + + ------ Debugging ---------------------------------------------------- + , Flag "dstg-stats" (NoArg (setDynFlag Opt_StgStats)) Supported + + , Flag "ddump-cmm" (setDumpFlag Opt_D_dump_cmm) + Supported + , Flag "ddump-cmmz" (setDumpFlag Opt_D_dump_cmmz) + Supported + , Flag "ddump-cmmz-pretty" (setDumpFlag Opt_D_dump_cmmz_pretty) + Supported + , Flag "ddump-cps-cmm" (setDumpFlag Opt_D_dump_cps_cmm) + Supported + , Flag "ddump-cvt-cmm" (setDumpFlag Opt_D_dump_cvt_cmm) + Supported + , Flag "ddump-asm" (setDumpFlag Opt_D_dump_asm) + Supported + , Flag "ddump-asm-native" (setDumpFlag Opt_D_dump_asm_native) + Supported + , Flag "ddump-asm-liveness" (setDumpFlag Opt_D_dump_asm_liveness) + Supported + , Flag "ddump-asm-coalesce" (setDumpFlag Opt_D_dump_asm_coalesce) + Supported + , Flag "ddump-asm-regalloc" (setDumpFlag Opt_D_dump_asm_regalloc) + Supported + , Flag "ddump-asm-conflicts" (setDumpFlag Opt_D_dump_asm_conflicts) + Supported + , Flag "ddump-asm-regalloc-stages" + (setDumpFlag Opt_D_dump_asm_regalloc_stages) + Supported + , Flag "ddump-asm-stats" (setDumpFlag Opt_D_dump_asm_stats) + Supported + , Flag "ddump-cpranal" (setDumpFlag Opt_D_dump_cpranal) + Supported + , Flag "ddump-deriv" (setDumpFlag Opt_D_dump_deriv) + Supported + , Flag "ddump-ds" (setDumpFlag Opt_D_dump_ds) + Supported + , Flag "ddump-flatC" (setDumpFlag Opt_D_dump_flatC) + Supported + , Flag "ddump-foreign" (setDumpFlag Opt_D_dump_foreign) + Supported + , Flag "ddump-inlinings" (setDumpFlag Opt_D_dump_inlinings) + Supported + , Flag "ddump-rule-firings" (setDumpFlag Opt_D_dump_rule_firings) + Supported + , Flag "ddump-occur-anal" (setDumpFlag Opt_D_dump_occur_anal) + Supported + , Flag "ddump-parsed" (setDumpFlag Opt_D_dump_parsed) + Supported + , Flag "ddump-rn" (setDumpFlag Opt_D_dump_rn) + Supported + , Flag "ddump-simpl" (setDumpFlag Opt_D_dump_simpl) + Supported + , Flag "ddump-simpl-iterations" (setDumpFlag Opt_D_dump_simpl_iterations) + Supported + , Flag "ddump-simpl-phases" (OptPrefix setDumpSimplPhases) + Supported + , Flag "ddump-spec" (setDumpFlag Opt_D_dump_spec) + Supported + , Flag "ddump-prep" (setDumpFlag Opt_D_dump_prep) + Supported + , Flag "ddump-stg" (setDumpFlag Opt_D_dump_stg) + Supported + , Flag "ddump-stranal" (setDumpFlag Opt_D_dump_stranal) + Supported + , Flag "ddump-tc" (setDumpFlag Opt_D_dump_tc) + Supported + , Flag "ddump-types" (setDumpFlag Opt_D_dump_types) + Supported + , Flag "ddump-rules" (setDumpFlag Opt_D_dump_rules) + Supported + , Flag "ddump-cse" (setDumpFlag Opt_D_dump_cse) + Supported + , Flag "ddump-worker-wrapper" (setDumpFlag Opt_D_dump_worker_wrapper) + Supported + , Flag "ddump-rn-trace" (setDumpFlag Opt_D_dump_rn_trace) + Supported + , Flag "ddump-if-trace" (setDumpFlag Opt_D_dump_if_trace) + Supported + , Flag "ddump-tc-trace" (setDumpFlag Opt_D_dump_tc_trace) + Supported + , Flag "ddump-splices" (setDumpFlag Opt_D_dump_splices) + Supported + , Flag "ddump-rn-stats" (setDumpFlag Opt_D_dump_rn_stats) + Supported + , Flag "ddump-opt-cmm" (setDumpFlag Opt_D_dump_opt_cmm) + Supported + , Flag "ddump-simpl-stats" (setDumpFlag Opt_D_dump_simpl_stats) + Supported + , Flag "ddump-bcos" (setDumpFlag Opt_D_dump_BCOs) + Supported + , Flag "dsource-stats" (setDumpFlag Opt_D_source_stats) + Supported + , Flag "dverbose-core2core" (NoArg setVerboseCore2Core) + Supported + , Flag "dverbose-stg2stg" (setDumpFlag Opt_D_verbose_stg2stg) + Supported + , Flag "ddump-hi" (setDumpFlag Opt_D_dump_hi) + Supported + , Flag "ddump-minimal-imports" (setDumpFlag Opt_D_dump_minimal_imports) + Supported + , Flag "ddump-vect" (setDumpFlag Opt_D_dump_vect) + Supported + , Flag "ddump-hpc" (setDumpFlag Opt_D_dump_hpc) + Supported + , Flag "ddump-mod-cycles" (setDumpFlag Opt_D_dump_mod_cycles) + Supported + , Flag "ddump-view-pattern-commoning" (setDumpFlag Opt_D_dump_view_pattern_commoning) + Supported + , Flag "ddump-to-file" (setDumpFlag Opt_DumpToFile) + Supported + , Flag "ddump-hi-diffs" (setDumpFlag Opt_D_dump_hi_diffs) + Supported + + , Flag "dcore-lint" (NoArg (setDynFlag Opt_DoCoreLinting)) + Supported + , Flag "dstg-lint" (NoArg (setDynFlag Opt_DoStgLinting)) + Supported + , Flag "dcmm-lint" (NoArg (setDynFlag Opt_DoCmmLinting)) + Supported + , Flag "dasm-lint" (NoArg (setDynFlag Opt_DoAsmLinting)) + Supported + , Flag "dshow-passes" + (NoArg (do setDynFlag Opt_ForceRecomp + setVerbosity (Just 2))) + Supported + , Flag "dfaststring-stats" (NoArg (setDynFlag Opt_D_faststring_stats)) + Supported + + ------ Machine dependant (-m) stuff --------------------------- + + , Flag "monly-2-regs" (NoArg (upd (\s -> s{stolen_x86_regs = 2}) )) + Supported + , Flag "monly-3-regs" (NoArg (upd (\s -> s{stolen_x86_regs = 3}) )) + Supported + , Flag "monly-4-regs" (NoArg (upd (\s -> s{stolen_x86_regs = 4}) )) + Supported + + ------ Warning opts ------------------------------------------------- + , Flag "W" (NoArg (mapM_ setDynFlag minusWOpts)) + Supported + , Flag "Werror" (NoArg (setDynFlag Opt_WarnIsError)) + Supported + , Flag "Wwarn" (NoArg (unSetDynFlag Opt_WarnIsError)) + Supported + , Flag "Wall" (NoArg (mapM_ setDynFlag minusWallOpts)) + Supported + , Flag "Wnot" (NoArg (mapM_ unSetDynFlag minusWallOpts)) + (Deprecated "Use -w instead") + , Flag "w" (NoArg (mapM_ unSetDynFlag minuswRemovesOpts)) + Supported + + ------ Optimisation flags ------------------------------------------ + , Flag "O" (NoArg (upd (setOptLevel 1))) Supported + , Flag "Onot" (NoArg (upd (setOptLevel 0))) + (Deprecated "Use -O0 instead") + , Flag "Odph" (NoArg (upd setDPHOpt)) Supported + , Flag "O" (OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1)))) + Supported + -- If the number is missing, use 1 + + , Flag "fsimplifier-phases" + (IntSuffix (\n -> upd (\dfs -> dfs{ simplPhases = n }))) + Supported + , Flag "fmax-simplifier-iterations" + (IntSuffix (\n -> upd (\dfs -> dfs{ maxSimplIterations = n }))) + Supported + + , Flag "fspec-constr-threshold" + (IntSuffix (\n -> upd (\dfs -> dfs{ specConstrThreshold = Just n }))) + Supported + , Flag "fno-spec-constr-threshold" + (NoArg (upd (\dfs -> dfs{ specConstrThreshold = Nothing }))) + Supported + , Flag "fspec-constr-count" + (IntSuffix (\n -> upd (\dfs -> dfs{ specConstrCount = Just n }))) + Supported + , Flag "fno-spec-constr-count" + (NoArg (upd (\dfs -> dfs{ specConstrCount = Nothing }))) + Supported + , Flag "fliberate-case-threshold" + (IntSuffix (\n -> upd (\dfs -> dfs{ liberateCaseThreshold = Just n }))) + Supported + , Flag "fno-liberate-case-threshold" + (NoArg (upd (\dfs -> dfs{ liberateCaseThreshold = Nothing }))) + Supported + + , Flag "frule-check" + (SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s }))) + Supported + , Flag "fcontext-stack" + (IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n }) + Supported + + ------ DPH flags ---------------------------------------------------- + + , Flag "fdph-seq" + (NoArg (upd (setDPHBackend DPHSeq))) + Supported + , Flag "fdph-par" + (NoArg (upd (setDPHBackend DPHPar))) + Supported ------ Compiler flags ----------------------------------------------- - , ( "fasm", NoArg (setObjTarget HscAsm) ) - , ( "fvia-c", NoArg (setObjTarget HscC) ) - , ( "fvia-C", NoArg (setObjTarget HscC) ) - - , ( "fno-code", NoArg (setTarget HscNothing)) - , ( "fbyte-code", NoArg (setTarget HscInterpreted) ) - , ( "fobject-code", NoArg (setTarget defaultHscTarget) ) + , Flag "fasm" (NoArg (setObjTarget HscAsm)) Supported + , Flag "fvia-c" (NoArg (setObjTarget HscC)) Supported + , Flag "fvia-C" (NoArg (setObjTarget HscC)) Supported - , ( "fglasgow-exts", NoArg (mapM_ setDynFlag glasgowExtsFlags) ) - , ( "fno-glasgow-exts", NoArg (mapM_ unSetDynFlag glasgowExtsFlags) ) + , Flag "fno-code" (NoArg (setTarget HscNothing)) Supported + , Flag "fbyte-code" (NoArg (setTarget HscInterpreted)) Supported + , Flag "fobject-code" (NoArg (setTarget defaultHscTarget)) Supported - -- the rest of the -f* and -fno-* flags - , ( "f", PrefixPred (isFlag fFlags) - (\f -> setDynFlag (getFlag fFlags f)) ) - , ( "f", PrefixPred (isPrefFlag "no-" fFlags) - (\f -> unSetDynFlag (getPrefFlag "no-" fFlags f)) ) - - -- the -X* and -XNo* flags - , ( "X", PrefixPred (isFlag xFlags) - (\f -> setDynFlag (getFlag xFlags f)) ) - , ( "X", PrefixPred (isPrefFlag "No" xFlags) - (\f -> unSetDynFlag (getPrefFlag "No" xFlags f)) ) + , Flag "fglasgow-exts" (NoArg (mapM_ setDynFlag glasgowExtsFlags)) + Supported + , Flag "fno-glasgow-exts" (NoArg (mapM_ unSetDynFlag glasgowExtsFlags)) + Supported ] + ++ map (mkFlag True "f" setDynFlag ) fFlags + ++ map (mkFlag False "fno-" unSetDynFlag) fFlags + ++ map (mkFlag True "X" setDynFlag ) xFlags + ++ map (mkFlag False "XNo" unSetDynFlag) xFlags + +mkFlag :: Bool -- True => turn it on, False => turn it off + -> String + -> (DynFlag -> DynP ()) + -> (String, DynFlag, Bool -> Deprecated) + -> Flag DynP +mkFlag turnOn flagPrefix f (name, dynflag, deprecated) + = Flag (flagPrefix ++ name) (NoArg (f dynflag)) (deprecated turnOn) + +deprecatedForLanguage :: String -> Bool -> Deprecated +deprecatedForLanguage lang turnOn = + Deprecated ("Use the " ++ prefix ++ lang ++ " language instead") + where prefix = if turnOn then "" else "No" -- these -f flags can all be reversed with -fno- +fFlags :: [(String, DynFlag, Bool -> Deprecated)] fFlags = [ - ( "warn-dodgy-imports", Opt_WarnDodgyImports ), - ( "warn-duplicate-exports", Opt_WarnDuplicateExports ), - ( "warn-hi-shadowing", Opt_WarnHiShadows ), - ( "warn-implicit-prelude", Opt_WarnImplicitPrelude ), - ( "warn-incomplete-patterns", Opt_WarnIncompletePatterns ), - ( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd ), - ( "warn-missing-fields", Opt_WarnMissingFields ), - ( "warn-missing-methods", Opt_WarnMissingMethods ), - ( "warn-missing-signatures", Opt_WarnMissingSigs ), - ( "warn-name-shadowing", Opt_WarnNameShadowing ), - ( "warn-overlapping-patterns", Opt_WarnOverlappingPatterns ), - ( "warn-simple-patterns", Opt_WarnSimplePatterns ), - ( "warn-type-defaults", Opt_WarnTypeDefaults ), - ( "warn-monomorphism-restriction", Opt_WarnMonomorphism ), - ( "warn-unused-binds", Opt_WarnUnusedBinds ), - ( "warn-unused-imports", Opt_WarnUnusedImports ), - ( "warn-unused-matches", Opt_WarnUnusedMatches ), - ( "warn-deprecations", Opt_WarnDeprecations ), - ( "warn-orphans", Opt_WarnOrphans ), - ( "warn-tabs", Opt_WarnTabs ), - ( "print-explicit-foralls", Opt_PrintExplicitForalls ), - ( "strictness", Opt_Strictness ), - ( "full-laziness", Opt_FullLaziness ), - ( "liberate-case", Opt_LiberateCase ), - ( "spec-constr", Opt_SpecConstr ), - ( "cse", Opt_CSE ), - ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas ), - ( "omit-interface-pragmas", Opt_OmitInterfacePragmas ), - ( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion ), - ( "ignore-asserts", Opt_IgnoreAsserts ), - ( "ignore-breakpoints", Opt_IgnoreBreakpoints), - ( "do-eta-reduction", Opt_DoEtaReduction ), - ( "case-merge", Opt_CaseMerge ), - ( "unbox-strict-fields", Opt_UnboxStrictFields ), - ( "dicts-cheap", Opt_DictsCheap ), - ( "excess-precision", Opt_ExcessPrecision ), - ( "asm-mangling", Opt_DoAsmMangling ), - ( "print-bind-result", Opt_PrintBindResult ), - ( "force-recomp", Opt_ForceRecomp ), - ( "hpc-no-auto", Opt_Hpc_No_Auto ), - ( "rewrite-rules", Opt_RewriteRules ), - ( "break-on-exception", Opt_BreakOnException ), - ( "vectorise", Opt_Vectorise ), - ( "regs-graph", Opt_RegsGraph), - -- Deprecated in favour of -XTemplateHaskell: - ( "th", Opt_TemplateHaskell ), - -- Deprecated in favour of -XForeignFunctionInterface: - ( "fi", Opt_ForeignFunctionInterface ), - -- Deprecated in favour of -XForeignFunctionInterface: - ( "ffi", Opt_ForeignFunctionInterface ), - -- Deprecated in favour of -XArrows: - ( "arrows", Opt_Arrows ), - -- Deprecated in favour of -XGenerics: - ( "generics", Opt_Generics ), - -- Deprecated in favour of -XImplicitPrelude: - ( "implicit-prelude", Opt_ImplicitPrelude ), - -- Deprecated in favour of -XBangPatterns: - ( "bang-patterns", Opt_BangPatterns ), - -- Deprecated in favour of -XMonomorphismRestriction: - ( "monomorphism-restriction", Opt_MonomorphismRestriction ), - -- Deprecated in favour of -XMonoPatBinds: - ( "mono-pat-binds", Opt_MonoPatBinds ), - -- Deprecated in favour of -XExtendedDefaultRules: - ( "extended-default-rules", Opt_ExtendedDefaultRules ), - -- Deprecated in favour of -XImplicitParams: - ( "implicit-params", Opt_ImplicitParams ), - -- Deprecated in favour of -XScopedTypeVariables: - ( "scoped-type-variables", Opt_ScopedTypeVariables ), - -- Deprecated in favour of -XPArr: - ( "parr", Opt_PArr ), - -- Deprecated in favour of -XOverlappingInstances: - ( "allow-overlapping-instances", Opt_OverlappingInstances ), - -- Deprecated in favour of -XUndecidableInstances: - ( "allow-undecidable-instances", Opt_UndecidableInstances ), - -- Deprecated in favour of -XIncoherentInstances: - ( "allow-incoherent-instances", Opt_IncoherentInstances ), - ( "gen-manifest", Opt_GenManifest ), - ( "embed-manifest", Opt_EmbedManifest ) + ( "warn-dodgy-foreign-imports", Opt_WarnDodgyForeignImports, const Supported ), + ( "warn-dodgy-imports", Opt_WarnDodgyImports, const Supported ), + ( "warn-duplicate-exports", Opt_WarnDuplicateExports, const Supported ), + ( "warn-hi-shadowing", Opt_WarnHiShadows, const Supported ), + ( "warn-implicit-prelude", Opt_WarnImplicitPrelude, const Supported ), + ( "warn-incomplete-patterns", Opt_WarnIncompletePatterns, const Supported ), + ( "warn-incomplete-record-updates", Opt_WarnIncompletePatternsRecUpd, const Supported ), + ( "warn-missing-fields", Opt_WarnMissingFields, const Supported ), + ( "warn-missing-methods", Opt_WarnMissingMethods, const Supported ), + ( "warn-missing-signatures", Opt_WarnMissingSigs, const Supported ), + ( "warn-name-shadowing", Opt_WarnNameShadowing, const Supported ), + ( "warn-overlapping-patterns", Opt_WarnOverlappingPatterns, const Supported ), + ( "warn-simple-patterns", Opt_WarnSimplePatterns, const Supported ), + ( "warn-type-defaults", Opt_WarnTypeDefaults, const Supported ), + ( "warn-monomorphism-restriction", Opt_WarnMonomorphism, const Supported ), + ( "warn-unused-binds", Opt_WarnUnusedBinds, const Supported ), + ( "warn-unused-imports", Opt_WarnUnusedImports, const Supported ), + ( "warn-unused-matches", Opt_WarnUnusedMatches, 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 ), + ( "print-explicit-foralls", Opt_PrintExplicitForalls, const Supported ), + ( "strictness", Opt_Strictness, const Supported ), + ( "static-argument-transformation", Opt_StaticArgumentTransformation, const Supported ), + ( "full-laziness", Opt_FullLaziness, const Supported ), + ( "liberate-case", Opt_LiberateCase, const Supported ), + ( "spec-constr", Opt_SpecConstr, const Supported ), + ( "cse", Opt_CSE, const Supported ), + ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas, const Supported ), + ( "omit-interface-pragmas", Opt_OmitInterfacePragmas, const Supported ), + ( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion, const Supported ), + ( "ignore-asserts", Opt_IgnoreAsserts, const Supported ), + ( "do-eta-reduction", Opt_DoEtaReduction, const Supported ), + ( "case-merge", Opt_CaseMerge, const Supported ), + ( "unbox-strict-fields", Opt_UnboxStrictFields, const Supported ), + ( "method-sharing", Opt_MethodSharing, const Supported ), + ( "dicts-cheap", Opt_DictsCheap, const Supported ), + ( "excess-precision", Opt_ExcessPrecision, const Supported ), + ( "asm-mangling", Opt_DoAsmMangling, const Supported ), + ( "print-bind-result", Opt_PrintBindResult, const Supported ), + ( "force-recomp", Opt_ForceRecomp, const Supported ), + ( "hpc-no-auto", Opt_Hpc_No_Auto, const Supported ), + ( "rewrite-rules", Opt_RewriteRules, const Supported ), + ( "break-on-exception", Opt_BreakOnException, const Supported ), + ( "break-on-error", Opt_BreakOnError, const Supported ), + ( "print-evld-with-show", Opt_PrintEvldWithShow, const Supported ), + ( "print-bind-contents", Opt_PrintBindContents, const Supported ), + ( "run-cps", Opt_RunCPSZ, const Supported ), + ( "convert-to-zipper-and-back", Opt_ConvertToZipCfgAndBack, const Supported ), + ( "vectorise", Opt_Vectorise, const Supported ), + ( "regs-graph", Opt_RegsGraph, const Supported ), + ( "regs-iterative", Opt_RegsIterative, const Supported ), + ( "th", Opt_TemplateHaskell, + deprecatedForLanguage "TemplateHaskell" ), + ( "fi", Opt_ForeignFunctionInterface, + deprecatedForLanguage "ForeignFunctionInterface" ), + ( "ffi", Opt_ForeignFunctionInterface, + deprecatedForLanguage "ForeignFunctionInterface" ), + ( "arrows", Opt_Arrows, + deprecatedForLanguage "Arrows" ), + ( "generics", Opt_Generics, + deprecatedForLanguage "Generics" ), + ( "implicit-prelude", Opt_ImplicitPrelude, + deprecatedForLanguage "ImplicitPrelude" ), + ( "bang-patterns", Opt_BangPatterns, + deprecatedForLanguage "BangPatterns" ), + ( "monomorphism-restriction", Opt_MonomorphismRestriction, + deprecatedForLanguage "MonomorphismRestriction" ), + ( "mono-pat-binds", Opt_MonoPatBinds, + deprecatedForLanguage "MonoPatBinds" ), + ( "extended-default-rules", Opt_ExtendedDefaultRules, + deprecatedForLanguage "ExtendedDefaultRules" ), + ( "implicit-params", Opt_ImplicitParams, + deprecatedForLanguage "ImplicitParams" ), + ( "scoped-type-variables", Opt_ScopedTypeVariables, + deprecatedForLanguage "ScopedTypeVariables" ), + ( "parr", Opt_PArr, + deprecatedForLanguage "PArr" ), + ( "allow-overlapping-instances", Opt_OverlappingInstances, + deprecatedForLanguage "OverlappingInstances" ), + ( "allow-undecidable-instances", Opt_UndecidableInstances, + deprecatedForLanguage "UndecidableInstances" ), + ( "allow-incoherent-instances", Opt_IncoherentInstances, + deprecatedForLanguage "IncoherentInstances" ), + ( "gen-manifest", Opt_GenManifest, const Supported ), + ( "embed-manifest", Opt_EmbedManifest, const Supported ) ] supportedLanguages :: [String] -supportedLanguages = map fst xFlags +supportedLanguages = [ name | (name, _, _) <- xFlags ] + +-- This may contain duplicates +languageOptions :: [DynFlag] +languageOptions = [ dynFlag | (_, dynFlag, _) <- xFlags ] -- These -X flags can all be reversed with -XNo -xFlags :: [(String, DynFlag)] +xFlags :: [(String, DynFlag, Bool -> Deprecated)] xFlags = [ - ( "CPP", Opt_Cpp ), - ( "PatternGuards", Opt_PatternGuards ), - ( "UnicodeSyntax", Opt_UnicodeSyntax ), - ( "MagicHash", Opt_MagicHash ), - ( "PolymorphicComponents", Opt_PolymorphicComponents ), - ( "ExistentialQuantification", Opt_ExistentialQuantification ), - ( "KindSignatures", Opt_KindSignatures ), - ( "PatternSignatures", Opt_PatternSignatures ), - ( "EmptyDataDecls", Opt_EmptyDataDecls ), - ( "ParallelListComp", Opt_ParallelListComp ), - ( "ForeignFunctionInterface", Opt_ForeignFunctionInterface ), - ( "UnliftedFFITypes", Opt_UnliftedFFITypes ), - ( "PartiallyAppliedClosedTypeSynonyms", - Opt_PartiallyAppliedClosedTypeSynonyms ), - ( "Rank2Types", Opt_Rank2Types ), - ( "RankNTypes", Opt_RankNTypes ), - ( "TypeOperators", Opt_TypeOperators ), - ( "RecursiveDo", Opt_RecursiveDo ), - ( "Arrows", Opt_Arrows ), - ( "PArr", Opt_PArr ), - ( "TemplateHaskell", Opt_TemplateHaskell ), - ( "Generics", Opt_Generics ), + ( "CPP", Opt_Cpp, const Supported ), + ( "PostfixOperators", Opt_PostfixOperators, const Supported ), + ( "PatternGuards", Opt_PatternGuards, const Supported ), + ( "UnicodeSyntax", Opt_UnicodeSyntax, const Supported ), + ( "MagicHash", Opt_MagicHash, const Supported ), + ( "PolymorphicComponents", Opt_PolymorphicComponents, const Supported ), + ( "ExistentialQuantification", Opt_ExistentialQuantification, const Supported ), + ( "KindSignatures", Opt_KindSignatures, const Supported ), + ( "PatternSignatures", Opt_PatternSignatures, const Supported ), + ( "EmptyDataDecls", Opt_EmptyDataDecls, const Supported ), + ( "ParallelListComp", Opt_ParallelListComp, const Supported ), + ( "TransformListComp", Opt_TransformListComp, const Supported ), + ( "ForeignFunctionInterface", Opt_ForeignFunctionInterface, const Supported ), + ( "UnliftedFFITypes", Opt_UnliftedFFITypes, const Supported ), + ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, const Supported ), + ( "Rank2Types", Opt_Rank2Types, const Supported ), + ( "RankNTypes", Opt_RankNTypes, const Supported ), + ( "ImpredicativeTypes", Opt_ImpredicativeTypes, const Supported ), + ( "TypeOperators", Opt_TypeOperators, const Supported ), + ( "RecursiveDo", Opt_RecursiveDo, const Supported ), + ( "Arrows", Opt_Arrows, const Supported ), + ( "PArr", Opt_PArr, const Supported ), + ( "TemplateHaskell", Opt_TemplateHaskell, const Supported ), + ( "QuasiQuotes", Opt_QuasiQuotes, const Supported ), + ( "Generics", Opt_Generics, const Supported ), -- On by default: - ( "ImplicitPrelude", Opt_ImplicitPrelude ), - ( "RecordWildCards", Opt_RecordWildCards ), - ( "RecordPuns", Opt_RecordPuns ), - ( "DisambiguateRecordFields", Opt_DisambiguateRecordFields ), - ( "OverloadedStrings", Opt_OverloadedStrings ), - ( "GADTs", Opt_GADTs ), - ( "TypeFamilies", Opt_TypeFamilies ), - ( "BangPatterns", Opt_BangPatterns ), + ( "ImplicitPrelude", Opt_ImplicitPrelude, const Supported ), + ( "RecordWildCards", Opt_RecordWildCards, const Supported ), + ( "NamedFieldPuns", Opt_RecordPuns, const Supported ), + ( "RecordPuns", Opt_RecordPuns, + deprecatedForLanguage "NamedFieldPuns" ), + ( "DisambiguateRecordFields", Opt_DisambiguateRecordFields, const Supported ), + ( "OverloadedStrings", Opt_OverloadedStrings, const Supported ), + ( "GADTs", Opt_GADTs, const Supported ), + ( "ViewPatterns", Opt_ViewPatterns, const Supported ), + ( "TypeFamilies", Opt_TypeFamilies, const Supported ), + ( "BangPatterns", Opt_BangPatterns, const Supported ), -- On by default: - ( "MonomorphismRestriction", Opt_MonomorphismRestriction ), + ( "MonomorphismRestriction", Opt_MonomorphismRestriction, const Supported ), -- On by default (which is not strictly H98): - ( "MonoPatBinds", Opt_MonoPatBinds ), - ( "RelaxedPolyRec", Opt_RelaxedPolyRec), - ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules ), - ( "ImplicitParams", Opt_ImplicitParams ), - ( "ScopedTypeVariables", Opt_ScopedTypeVariables ), - ( "UnboxedTuples", Opt_UnboxedTuples ), - ( "StandaloneDeriving", Opt_StandaloneDeriving ), - ( "DeriveDataTypeable", Opt_DeriveDataTypeable ), - ( "TypeSynonymInstances", Opt_TypeSynonymInstances ), - ( "FlexibleContexts", Opt_FlexibleContexts ), - ( "FlexibleInstances", Opt_FlexibleInstances ), - ( "ConstrainedClassMethods", Opt_ConstrainedClassMethods ), - ( "MultiParamTypeClasses", Opt_MultiParamTypeClasses ), - ( "FunctionalDependencies", Opt_FunctionalDependencies ), - ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving ), - ( "OverlappingInstances", Opt_OverlappingInstances ), - ( "UndecidableInstances", Opt_UndecidableInstances ), - ( "IncoherentInstances", Opt_IncoherentInstances ) + ( "MonoPatBinds", Opt_MonoPatBinds, const Supported ), + ( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ), + ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ), + ( "ImplicitParams", Opt_ImplicitParams, const Supported ), + ( "ScopedTypeVariables", Opt_ScopedTypeVariables, const Supported ), + ( "UnboxedTuples", Opt_UnboxedTuples, const Supported ), + ( "StandaloneDeriving", Opt_StandaloneDeriving, const Supported ), + ( "DeriveDataTypeable", Opt_DeriveDataTypeable, const Supported ), + ( "TypeSynonymInstances", Opt_TypeSynonymInstances, const Supported ), + ( "FlexibleContexts", Opt_FlexibleContexts, const Supported ), + ( "FlexibleInstances", Opt_FlexibleInstances, const Supported ), + ( "ConstrainedClassMethods", Opt_ConstrainedClassMethods, const Supported ), + ( "MultiParamTypeClasses", Opt_MultiParamTypeClasses, const Supported ), + ( "FunctionalDependencies", Opt_FunctionalDependencies, const Supported ), + ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving, const Supported ), + ( "OverlappingInstances", Opt_OverlappingInstances, const Supported ), + ( "UndecidableInstances", Opt_UndecidableInstances, const Supported ), + ( "IncoherentInstances", Opt_IncoherentInstances, const Supported ) ] impliedFlags :: [(DynFlag, [DynFlag])] impliedFlags = [ - ( Opt_GADTs, [Opt_RelaxedPolyRec] ) -- We want type-sig variables to be completely rigid for GADTs + ( Opt_GADTs, [Opt_RelaxedPolyRec] ) -- We want type-sig variables to + -- be completely rigid for GADTs + , ( Opt_ScopedTypeVariables, [Opt_RelaxedPolyRec] ) -- Ditto for scoped type variables; see + -- Note [Scoped tyvars] in TcBinds ] +glasgowExtsFlags :: [DynFlag] glasgowExtsFlags = [ Opt_PrintExplicitForalls , Opt_ForeignFunctionInterface , Opt_UnliftedFFITypes - , Opt_GADTs - , Opt_ImplicitParams - , Opt_ScopedTypeVariables + , Opt_GADTs + , Opt_ImplicitParams + , Opt_ScopedTypeVariables , Opt_UnboxedTuples , Opt_TypeSynonymInstances , Opt_StandaloneDeriving @@ -1301,13 +1573,15 @@ glasgowExtsFlags = [ , Opt_ConstrainedClassMethods , Opt_MultiParamTypeClasses , Opt_FunctionalDependencies - , Opt_MagicHash + , Opt_MagicHash , Opt_PolymorphicComponents , Opt_ExistentialQuantification , Opt_UnicodeSyntax + , Opt_PostfixOperators , Opt_PatternGuards - , Opt_PartiallyAppliedClosedTypeSynonyms + , Opt_LiberalTypeSynonyms , Opt_RankNTypes + , Opt_ImpredicativeTypes , Opt_TypeOperators , Opt_RecursiveDo , Opt_ParallelListComp @@ -1315,43 +1589,23 @@ glasgowExtsFlags = [ , Opt_KindSignatures , Opt_PatternSignatures , Opt_GeneralizedNewtypeDeriving - , Opt_TypeFamilies ] - ------------------- -isFlag :: [(String,a)] -> String -> Bool -isFlag flags f = any (\(ff,_) -> ff == f) flags - -isPrefFlag :: String -> [(String,a)] -> String -> Bool -isPrefFlag pref flags no_f - | Just f <- maybePrefixMatch pref no_f = isFlag flags f - | otherwise = False - ------------------- -getFlag :: [(String,a)] -> String -> a -getFlag flags f = case [ opt | (ff, opt) <- flags, ff == f] of - (o:os) -> o - [] -> panic ("get_flag " ++ f) - -getPrefFlag :: String -> [(String,a)] -> String -> a -getPrefFlag pref flags f = getFlag flags (fromJust (maybePrefixMatch pref f)) --- We should only be passed flags which match the prefix + , Opt_TypeFamilies ] -- ----------------------------------------------------------------------------- -- Parsing the dynamic flags. -parseDynamicFlags :: DynFlags -> [String] -> IO (DynFlags,[String]) +parseDynamicFlags :: DynFlags -> [String] -> IO (DynFlags, [String], [String]) parseDynamicFlags dflags args = do - let ((leftover,errs),dflags') - = runCmdLine (processArgs dynamic_flags args) dflags + let ((leftover, errs, warns), dflags') + = runCmdLine (processArgs dynamic_flags args) dflags when (not (null errs)) $ do throwDyn (UsageError (unlines errs)) - return (dflags', leftover) - + return (dflags', leftover, warns) type DynP = CmdLineP DynFlags upd :: (DynFlags -> DynFlags) -> DynP () -upd f = do +upd f = do dfs <- getCmdLineState putCmdLineState $! (f dfs) @@ -1360,33 +1614,81 @@ setDynFlag, unSetDynFlag :: DynFlag -> DynP () setDynFlag f = upd (\dfs -> foldl dopt_set (dopt_set dfs f) deps) where deps = [ d | (f', ds) <- impliedFlags, f' == f, d <- ds ] - -- When you set f, set the ones it implies - -- When you un-set f, however, we don't un-set the things it implies - -- (except for -fno-glasgow-exts, which is treated specially) + -- When you set f, set the ones it implies + -- When you un-set f, however, we don't un-set the things it implies + -- (except for -fno-glasgow-exts, which is treated specially) unSetDynFlag f = upd (\dfs -> dopt_unset dfs f) -------------------------- setDumpFlag :: DynFlag -> OptKind DynP -setDumpFlag dump_flag - = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag dump_flag) - -- Whenver we -ddump, switch off the recompilation checker, - -- else you don't see the dump! +setDumpFlag dump_flag + | force_recomp = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag dump_flag) + | otherwise = NoArg (setDynFlag dump_flag) + where + -- Whenver we -ddump, switch off the recompilation checker, + -- else you don't see the dump! + -- However, certain dumpy-things are really interested in what's going + -- on during recompilation checking, so in those cases we + -- don't want to turn it off. + force_recomp = dump_flag `notElem` [Opt_D_dump_if_trace, + Opt_D_dump_hi_diffs] + +setVerboseCore2Core :: DynP () +setVerboseCore2Core = do setDynFlag Opt_ForceRecomp + setDynFlag Opt_D_verbose_core2core + upd (\s -> s { shouldDumpSimplPhase = const True }) + +setDumpSimplPhases :: String -> DynP () +setDumpSimplPhases s = do setDynFlag Opt_ForceRecomp + upd (\s -> s { shouldDumpSimplPhase = spec }) + where + spec :: SimplifierMode -> Bool + spec = join (||) + . map (join (&&) . map match . split ':') + . split ',' + $ case s of + '=' : s' -> s' + _ -> s + + join :: (Bool -> Bool -> Bool) + -> [SimplifierMode -> Bool] + -> SimplifierMode -> Bool + join _ [] = const True + join op ss = foldr1 (\f g x -> f x `op` g x) ss + + match :: String -> SimplifierMode -> Bool + match "" = const True + match s = case reads s of + [(n,"")] -> phase_num n + _ -> phase_name s + + phase_num :: Int -> SimplifierMode -> Bool + phase_num n (SimplPhase k _) = n == k + phase_num _ _ = False + + phase_name :: String -> SimplifierMode -> Bool + phase_name s SimplGently = s == "gentle" + phase_name s (SimplPhase _ ss) = s `elem` ss setVerbosity :: Maybe Int -> DynP () setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 }) +addCmdlineHCInclude :: String -> DynP () addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes s}) +extraPkgConf_ :: FilePath -> DynP () extraPkgConf_ p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s }) -exposePackage p = +exposePackage, hidePackage, ignorePackage :: String -> DynP () +exposePackage p = upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s }) -hidePackage p = +hidePackage p = upd (\s -> s{ packageFlags = HidePackage p : packageFlags s }) -ignorePackage p = +ignorePackage p = upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s }) +setPackageName :: String -> DynFlags -> DynFlags setPackageName p | Nothing <- unpackPackageId pid = throwDyn (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier")) @@ -1397,9 +1699,10 @@ setPackageName p -- If we're linking a binary, then only targets that produce object -- code are allowed (requests for other target types are ignored). +setTarget :: HscTarget -> DynP () setTarget l = upd set - where - set dfs + where + set dfs | ghcLink dfs /= LinkBinary || isObjectTarget l = dfs{ hscTarget = l } | otherwise = dfs @@ -1407,67 +1710,97 @@ setTarget l = upd set -- used by -fasm and -fvia-C, which switch from one to the other, but -- not from bytecode to object-code. The idea is that -fasm/-fvia-C -- can be safely used in an OPTIONS_GHC pragma. +setObjTarget :: HscTarget -> DynP () setObjTarget l = upd set - where - set dfs + where + set dfs | isObjectTarget (hscTarget dfs) = dfs { hscTarget = l } | otherwise = dfs setOptLevel :: Int -> DynFlags -> DynFlags setOptLevel n dflags | hscTarget dflags == HscInterpreted && n > 0 - = dflags - -- not in IO any more, oh well: - -- putStr "warning: -O conflicts with --interactive; -O ignored.\n" + = dflags + -- not in IO any more, oh well: + -- putStr "warning: -O conflicts with --interactive; -O ignored.\n" | otherwise - = updOptLevel n dflags + = updOptLevel n dflags + + +-- -Odph is equivalent to +-- +-- -O2 optimise as much as possible +-- -fno-method-sharing sharing specialisation defeats fusion +-- sometimes +-- -fdicts-cheap always inline dictionaries +-- -fmax-simplifier-iterations20 this is necessary sometimes +-- -fno-spec-constr-threshold run SpecConstr even for big loops +-- +setDPHOpt :: DynFlags -> DynFlags +setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20 + , specConstrThreshold = Nothing + }) + `dopt_set` Opt_DictsCheap + `dopt_unset` Opt_MethodSharing + +data DPHBackend = DPHPar + | DPHSeq + +setDPHBackend :: DPHBackend -> DynFlags -> DynFlags +setDPHBackend backend dflags = dflags { dphBackend = backend } setMainIs :: String -> DynP () setMainIs arg - | not (null main_fn) -- The arg looked like "Foo.baz" + | not (null main_fn) && isLower (head main_fn) + -- The arg looked like "Foo.Bar.baz" = upd $ \d -> d{ mainFunIs = Just main_fn, - mainModIs = mkModule mainPackageId (mkModuleName main_mod) } + mainModIs = mkModule mainPackageId (mkModuleName main_mod) } + + | isUpper (head arg) -- The arg looked like "Foo" or "Foo.Bar" + = upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName arg) } - | isUpper (head main_mod) -- The arg looked like "Foo" - = upd $ \d -> d{ mainModIs = mkModule mainPackageId (mkModuleName main_mod) } - - | otherwise -- The arg looked like "baz" - = upd $ \d -> d{ mainFunIs = Just main_mod } + | otherwise -- The arg looked like "baz" + = upd $ \d -> d{ mainFunIs = Just arg } where (main_mod, main_fn) = splitLongestPrefix arg (== '.') ----------------------------------------------------------------------------- -- Paths & Libraries +addImportPath, addLibraryPath, addIncludePath, addFrameworkPath :: FilePath -> DynP () + -- -i on its own deletes the import paths addImportPath "" = upd (\s -> s{importPaths = []}) addImportPath p = upd (\s -> s{importPaths = importPaths s ++ splitPathList p}) -addLibraryPath p = +addLibraryPath p = upd (\s -> s{libraryPaths = libraryPaths s ++ splitPathList p}) -addIncludePath p = +addIncludePath p = upd (\s -> s{includePaths = includePaths s ++ splitPathList p}) -addFrameworkPath p = +addFrameworkPath p = upd (\s -> s{frameworkPaths = frameworkPaths s ++ splitPathList p}) +#ifndef mingw32_TARGET_OS +split_marker :: Char split_marker = ':' -- not configurable (ToDo) +#endif splitPathList :: String -> [String] splitPathList s = filter notNull (splitUp s) - -- empty paths are ignored: there might be a trailing - -- ':' in the initial list, for example. Empty paths can - -- cause confusion when they are translated into -I options - -- for passing to gcc. + -- empty paths are ignored: there might be a trailing + -- ':' in the initial list, for example. Empty paths can + -- cause confusion when they are translated into -I options + -- for passing to gcc. where #ifndef mingw32_TARGET_OS splitUp xs = split split_marker xs -#else +#else -- Windows: 'hybrid' support for DOS-style paths in directory lists. - -- + -- -- That is, if "foo:bar:baz" is used, this interpreted as -- consisting of three entries, 'foo', 'bar', 'baz'. -- However, with "c:/foo:c:\\foo;x:/bar", this is interpreted @@ -1480,26 +1813,26 @@ splitPathList s = filter notNull (splitUp s) -- So, use either. splitUp [] = [] splitUp (x:':':div:xs) | div `elem` dir_markers - = ((x:':':div:p): splitUp rs) - where - (p,rs) = findNextPath xs - -- we used to check for existence of the path here, but that - -- required the IO monad to be threaded through the command-line - -- parser which is quite inconvenient. The + = ((x:':':div:p): splitUp rs) + where + (p,rs) = findNextPath xs + -- we used to check for existence of the path here, but that + -- required the IO monad to be threaded through the command-line + -- parser which is quite inconvenient. The splitUp xs = cons p (splitUp rs) - where - (p,rs) = findNextPath xs - - cons "" xs = xs - cons x xs = x:xs + where + (p,rs) = findNextPath xs + + cons "" xs = xs + cons x xs = x:xs -- will be called either when we've consumed nought or the -- ":/" part of a DOS path, so splitting is just a Q of -- finding the next split marker. - findNextPath xs = + findNextPath xs = case break (`elem` split_markers) xs of - (p, d:ds) -> (p, ds) - (p, xs) -> (p, xs) + (p, _:ds) -> (p, ds) + (p, xs) -> (p, xs) split_markers :: [Char] split_markers = [':', ';'] @@ -1512,36 +1845,9 @@ splitPathList s = filter notNull (splitUp s) -- tmpDir, where we store temporary files. setTmpDir :: FilePath -> DynFlags -> DynFlags -setTmpDir dir dflags = dflags{ tmpDir = canonicalise dir } - where -#if !defined(mingw32_HOST_OS) - canonicalise p = normalisePath p -#else - -- Canonicalisation of temp path under win32 is a bit more - -- involved: (a) strip trailing slash, - -- (b) normalise slashes - -- (c) just in case, if there is a prefix /cygdrive/x/, change to x: - -- - canonicalise path = normalisePath (xltCygdrive (removeTrailingSlash path)) - - -- if we're operating under cygwin, and TMP/TEMP is of - -- the form "/cygdrive/drive/path", translate this to - -- "drive:/path" (as GHC isn't a cygwin app and doesn't - -- understand /cygdrive paths.) - xltCygdrive path - | "/cygdrive/" `isPrefixOf` path = - case drop (length "/cygdrive/") path of - drive:xs@('/':_) -> drive:':':xs - _ -> path - | otherwise = path - - -- strip the trailing backslash (awful, but we only do this once). - removeTrailingSlash path = - case last path of - '/' -> init path - '\\' -> init path - _ -> path -#endif +setTmpDir dir dflags = dflags{ tmpDir = normalise dir } + -- we used to fix /cygdrive/c/.. on Windows, but this doesn't + -- seem necessary now --SDM 7/2/2008 ----------------------------------------------------------------------------- -- Hpc stuff @@ -1565,22 +1871,22 @@ setOptHpcDir arg = upd $ \ d -> d{hpcDir = arg} -- platform. machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations - [String]) -- for registerised HC compilations -machdepCCOpts dflags + [String]) -- for registerised HC compilations +machdepCCOpts _dflags #if alpha_TARGET_ARCH - = ( ["-w", "-mieee" + = ( ["-w", "-mieee" #ifdef HAVE_THREADED_RTS_SUPPORT - , "-D_REENTRANT" + , "-D_REENTRANT" #endif - ], [] ) - -- For now, to suppress the gcc warning "call-clobbered - -- register used for global register variable", we simply - -- disable all warnings altogether using the -w flag. Oh well. + ], [] ) + -- For now, to suppress the gcc warning "call-clobbered + -- register used for global register variable", we simply + -- disable all warnings altogether using the -w flag. Oh well. #elif hppa_TARGET_ARCH -- ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi! -- (very nice, but too bad the HP /usr/include files don't agree.) - = ( ["-D_HPUX_SOURCE"], [] ) + = ( ["-D_HPUX_SOURCE"], [] ) #elif m68k_TARGET_ARCH -- -fno-defer-pop : for the .hc files, we want all the pushing/ @@ -1592,49 +1898,48 @@ machdepCCOpts dflags -- rather than let GCC pick random things to do with it. -- (If we want to steal a6, then we would try to do things -- as on iX86, where we *do* steal the frame pointer [%ebp].) - = ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] ) + = ( [], ["-fno-defer-pop", "-fno-omit-frame-pointer"] ) #elif i386_TARGET_ARCH -- -fno-defer-pop : basically the same game as for m68k -- -- -fomit-frame-pointer : *must* in .hc files; because we're stealing -- the fp (%ebp) for our register maps. - = let n_regs = stolen_x86_regs dflags - sta = opt_Static - in - ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "" --- , if "mingw32" `isSuffixOf` cTARGETPLATFORM then "-mno-cygwin" else "" - ], - [ "-fno-defer-pop", - "-fomit-frame-pointer", - -- we want -fno-builtin, because when gcc inlines - -- built-in functions like memcpy() it tends to - -- run out of registers, requiring -monly-n-regs - "-fno-builtin", - "-DSTOLEN_X86_REGS="++show n_regs ] - ) + = let n_regs = stolen_x86_regs _dflags + sta = opt_Static + in + ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "" + ], + [ "-fno-defer-pop", + "-fomit-frame-pointer", + -- we want -fno-builtin, because when gcc inlines + -- built-in functions like memcpy() it tends to + -- run out of registers, requiring -monly-n-regs + "-fno-builtin", + "-DSTOLEN_X86_REGS="++show n_regs ] + ) #elif ia64_TARGET_ARCH - = ( [], ["-fomit-frame-pointer", "-G0"] ) + = ( [], ["-fomit-frame-pointer", "-G0"] ) #elif x86_64_TARGET_ARCH - = ( [], ["-fomit-frame-pointer", - "-fno-asynchronous-unwind-tables", - -- the unwind tables are unnecessary for HC code, - -- and get in the way of -split-objs. Another option - -- would be to throw them away in the mangler, but this - -- is easier. - "-fno-builtin" - -- calling builtins like strlen() using the FFI can - -- cause gcc to run out of regs, so use the external - -- version. - ] ) + = ( [], ["-fomit-frame-pointer", + "-fno-asynchronous-unwind-tables", + -- the unwind tables are unnecessary for HC code, + -- and get in the way of -split-objs. Another option + -- would be to throw them away in the mangler, but this + -- is easier. + "-fno-builtin" + -- calling builtins like strlen() using the FFI can + -- cause gcc to run out of regs, so use the external + -- version. + ] ) #elif sparc_TARGET_ARCH - = ( [], ["-w"] ) - -- For now, to suppress the gcc warning "call-clobbered - -- register used for global register variable", we simply - -- disable all warnings altogether using the -w flag. Oh well. + = ( [], ["-w"] ) + -- For now, to suppress the gcc warning "call-clobbered + -- register used for global register variable", we simply + -- disable all warnings altogether using the -w flag. Oh well. #elif powerpc_apple_darwin_TARGET -- -no-cpp-precomp: @@ -1643,11 +1948,11 @@ machdepCCOpts dflags -- declarations. = ( [], ["-no-cpp-precomp"] ) #else - = ( [], [] ) + = ( [], [] ) #endif picCCOpts :: DynFlags -> [String] -picCCOpts dflags +picCCOpts _dflags #if darwin_TARGET_OS -- Apple prefers to do things the other way round. -- PIC is on by default. @@ -1697,5 +2002,7 @@ compilerInfo = [("Project name", cProjectName), ("Tables next to code", cGhcEnableTablesNextToCode), ("Win32 DLLs", cEnableWin32DLLs), ("RTS ways", cGhcRTSWays), - ("Leading underscore", cLeadingUnderscore)] + ("Leading underscore", cLeadingUnderscore), + ("Debug on", show debugIsOn) + ]