X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=be0212e744d2685b29e88b4f51ea18cd7d82b8c9;hp=853155d9692fa65346312104b8fa055f6e7e045b;hb=842e9d6628a27cf1f420d53f6a5901935dc50c54;hpb=df9814b4b29c92cd421d1404757f525b264b9714 diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 853155d..be0212e 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1,5 +1,11 @@ {-# OPTIONS -fno-warn-missing-fields #-} +-- 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/Commentary/CodingStyle#Warnings +-- for details + ----------------------------------------------------------------------------- -- -- Dynamic flags @@ -22,6 +28,8 @@ module DynFlags ( GhcLink(..), isNoLink, PackageFlag(..), Option(..), + DynLibLoader(..), + fFlags, xFlags, -- Configuration of the core-to-core and stg-to-stg phases CoreToDo(..), @@ -47,12 +55,14 @@ module DynFlags ( allFlags, -- misc stuff - machdepCCOpts, picCCOpts + machdepCCOpts, picCCOpts, + supportedLanguages, + compilerInfo, ) where #include "HsVersions.h" -import Module ( Module, mkModuleName, mkModule ) +import Module import PackageConfig import PrelNames ( mAIN ) #ifdef i386_TARGET_ARCH @@ -67,7 +77,7 @@ import CmdLineParser import Constants ( mAX_CONTEXT_REDUCTION_DEPTH ) import Panic ( panic, GhcException(..) ) import UniqFM ( UniqFM ) -import Util ( notNull, splitLongestPrefix, normalisePath ) +import Util import Maybes ( orElse, fromJust ) import SrcLoc ( SrcSpan ) import Outputable @@ -76,13 +86,9 @@ import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) 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 Data.Char ( isUpper, toLower ) +import Data.Char +import System.FilePath import System.IO ( hPutStrLn, stderr ) -- ----------------------------------------------------------------------------- @@ -92,8 +98,18 @@ 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 + | Opt_D_dump_asm_coalesce + | Opt_D_dump_asm_regalloc + | Opt_D_dump_asm_regalloc_stages + | Opt_D_dump_asm_conflicts + | Opt_D_dump_asm_stats | Opt_D_dump_cpranal | Opt_D_dump_deriv | Opt_D_dump_ds @@ -106,6 +122,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 @@ -132,12 +149,15 @@ 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_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 @@ -160,31 +180,38 @@ data DynFlag | Opt_WarnTabs -- language opts - | Opt_AllowOverlappingInstances - | Opt_AllowUndecidableInstances - | Opt_AllowIncoherentInstances + | Opt_OverlappingInstances + | Opt_UndecidableInstances + | Opt_IncoherentInstances | Opt_MonomorphismRestriction | Opt_MonoPatBinds | Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting - | Opt_GlasgowExts - | Opt_FFI + | Opt_ForeignFunctionInterface + | Opt_UnliftedFFITypes | Opt_PArr -- Syntactic support for parallel arrays | Opt_Arrows -- Arrow-notation syntax - | Opt_TH + | Opt_TemplateHaskell + | Opt_QuasiQuotes | Opt_ImplicitParams | Opt_Generics | Opt_ImplicitPrelude | Opt_ScopedTypeVariables + | Opt_UnboxedTuples | Opt_BangPatterns | Opt_TypeFamilies | Opt_OverloadedStrings | Opt_DisambiguateRecordFields | Opt_RecordWildCards | Opt_RecordPuns + | Opt_ViewPatterns | Opt_GADTs - | Opt_RelaxedPolyRec -- -X=RelaxedPolyRec + | Opt_RelaxedPolyRec + | Opt_StandaloneDeriving + | Opt_DeriveDataTypeable | Opt_TypeSynonymInstances + | Opt_FlexibleContexts | Opt_FlexibleInstances + | Opt_ConstrainedClassMethods | Opt_MultiParamTypeClasses | Opt_FunctionalDependencies | Opt_UnicodeSyntax @@ -193,16 +220,24 @@ data DynFlag | Opt_MagicHash | Opt_EmptyDataDecls | Opt_KindSignatures + | Opt_PatternSignatures | Opt_ParallelListComp + | Opt_TransformListComp | Opt_GeneralizedNewtypeDeriving | Opt_RecursiveDo | Opt_PatternGuards + | Opt_LiberalTypeSynonyms | Opt_Rank2Types | Opt_RankNTypes + | Opt_ImpredicativeTypes + | Opt_TypeOperators + + | Opt_PrintExplicitForalls -- optimisation opts | Opt_Strictness | Opt_FullLaziness + | Opt_StaticArgumentTransformation | Opt_CSE | Opt_LiberateCase | Opt_SpecConstr @@ -210,13 +245,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 -- do graph coloring register allocation + | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation -- misc opts | Opt_Cpp @@ -232,8 +269,16 @@ 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 -- keeping stuff | Opt_KeepHiDiffs @@ -242,7 +287,7 @@ data DynFlag | Opt_KeepRawSFiles | Opt_KeepTmpFiles - deriving (Eq) + deriving (Eq, Show) data DynFlags = DynFlags { ghcMode :: GhcMode, @@ -254,10 +299,14 @@ data DynFlags = DynFlags { 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, - specThreshold :: Int, -- Threshold for function specialisation + 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 @@ -284,6 +333,15 @@ data DynFlags = DynFlags { outputFile :: Maybe String, outputHi :: Maybe String, + dynLibLoader :: DynLibLoader, + + -- | This is set by DriverPipeline.runPipeline based on where + -- 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], @@ -304,8 +362,8 @@ data DynFlags = DynFlags { opt_m :: [String], opt_a :: [String], opt_l :: [String], - opt_dll :: [String], opt_dep :: [String], + opt_windres :: [String], -- commands for particular phases pgm_L :: String, @@ -319,6 +377,7 @@ data DynFlags = DynFlags { pgm_dll :: (String,[Option]), pgm_T :: String, pgm_sysman :: String, + pgm_windres :: String, -- Package flags extraPkgConfs :: [FilePath], @@ -333,14 +392,16 @@ data DynFlags = DynFlags { -- Package state -- NB. do not modify this field, it is calculated by -- Packages.initPackages and Packages.updatePackages. - pkgDatabase :: Maybe (UniqFM InstalledPackageInfo), + pkgDatabase :: Maybe (UniqFM PackageConfig), pkgState :: PackageState, -- hsc dynamic flags flags :: [DynFlag], -- message output - log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO () + log_action :: Severity -> SrcSpan -> PprStyle -> Message -> IO (), + + haddockOptions :: Maybe String } data HscTarget @@ -379,11 +440,11 @@ data GhcLink -- What to do in the link step, if there is one | 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 + deriving (Eq, Show) isNoLink :: GhcLink -> Bool isNoLink NoLink = True -isNoLink other = False +isNoLink _ = False data PackageFlag = ExposePackage String @@ -391,14 +452,23 @@ 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 +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 @@ -410,6 +480,7 @@ initDynFlags dflags = do rtsBuildTag = rts_build_tag } +defaultDynFlags :: DynFlags defaultDynFlags = DynFlags { ghcMode = CompManager, @@ -421,9 +492,13 @@ defaultDynFlags = extCoreName = "", verbosity = 0, optLevel = 0, + simplPhases = 2, maxSimplIterations = 4, + shouldDumpSimplPhase = const False, ruleCheck = Nothing, - specThreshold = 200, + specConstrThreshold = Just 200, + specConstrCount = Just 3, + liberateCaseThreshold = Just 200, stolen_x86_regs = 4, cmdlineHcIncludes = [], importPaths = ["."], @@ -443,6 +518,9 @@ defaultDynFlags = outputFile = Nothing, outputHi = Nothing, + dynLibLoader = Deployable, + dumpPrefix = Nothing, + dumpPrefixForce = Nothing, includePaths = [], libraryPaths = [], frameworkPaths = [], @@ -452,37 +530,44 @@ defaultDynFlags = hpcDir = ".hpc", opt_L = [], - opt_P = [], + opt_P = (if opt_PIC + then ["-D__PIC__"] + else []), opt_F = [], opt_c = [], opt_a = [], opt_m = [], opt_l = [], - opt_dll = [], opt_dep = [], + opt_windres = [], 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 + haddockOptions = Nothing, + flags = [ + Opt_ReadUserPackageConf, - Opt_ImplicitPrelude, - Opt_MonomorphismRestriction, + 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, - Opt_DoAsmMangling, - - -- on by default: - Opt_PrintBindResult ] - ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] - -- The default -O0 options - ++ standardWarnings, - log_action = \severity srcSpan style msg -> case severity of SevInfo -> hPutStrLn stderr (show (msg style)) @@ -519,9 +604,19 @@ 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} @@ -530,6 +625,17 @@ 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"] -- Config.hs should really use Option. setPgmP f d = let (pgm:args) = words f in d{ pgm_P = (pgm, map Option args)} @@ -542,6 +648,7 @@ setPgms f d = d{ pgm_s = (f,[])} setPgma f d = d{ pgm_a = (f,[])} setPgml f d = d{ pgm_l = (f,[])} setPgmdll f d = d{ pgm_dll = (f,[])} +setPgmwindres f d = d{ pgm_windres = f} addOptL f d = d{ opt_L = f : opt_L d} addOptP f d = d{ opt_P = f : opt_P d} @@ -550,11 +657,13 @@ addOptc f d = d{ opt_c = f : opt_c d} addOptm f d = d{ opt_m = f : opt_m d} addOpta f d = d{ opt_a = f : opt_a d} addOptl f d = d{ opt_l = f : opt_l d} -addOptdll f d = d{ opt_dll = f : opt_dll d} addOptdep f d = d{ opt_dep = f : opt_dep d} +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 @@ -603,6 +712,7 @@ optLevelFlags , ([2], Opt_LiberateCase) , ([2], Opt_SpecConstr) + , ([2], Opt_StaticArgumentTransformation) , ([0,1,2], Opt_DoLambdaEtaExpansion) -- This one is important for a tiresome reason: @@ -614,6 +724,7 @@ optLevelFlags -- ----------------------------------------------------------------------------- -- Standard sets of warning options +standardWarnings :: [DynFlag] standardWarnings = [ Opt_WarnDeprecations, Opt_WarnOverlappingPatterns, @@ -622,6 +733,7 @@ standardWarnings Opt_WarnDuplicateExports ] +minusWOpts :: [DynFlag] minusWOpts = standardWarnings ++ [ Opt_WarnUnusedBinds, @@ -631,6 +743,7 @@ minusWOpts Opt_WarnDodgyImports ] +minusWallOpts :: [DynFlag] minusWallOpts = minusWOpts ++ [ Opt_WarnTypeDefaults, @@ -640,6 +753,17 @@ minusWallOpts Opt_WarnOrphans ] +-- minuswRemovesOpts should be every warning option +minuswRemovesOpts :: [DynFlag] +minuswRemovesOpts + = minusWallOpts ++ + [Opt_WarnImplicitPrelude, + Opt_WarnIncompletePatternsRecUpd, + Opt_WarnSimplePatterns, + Opt_WarnMonomorphism, + Opt_WarnTabs + ] + -- ----------------------------------------------------------------------------- -- CoreToDo: abstraction of core-to-core passes to run. @@ -666,12 +790,13 @@ data CoreToDo -- These are diff core-to-core passes, | 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 data SimplifierMode -- See comments in SimplMonad = SimplGently - | SimplPhase Int + | SimplPhase Int [String] data SimplifierSwitch = MaxSimplifierIterations Int @@ -686,7 +811,11 @@ data FloatOutSwitches -- 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 @@ -694,6 +823,7 @@ getCoreToDo dflags | otherwise = core_todo where opt_level = optLevel dflags + phases = simplPhases dflags max_iter = maxSimplIterations dflags strictness = dopt Opt_Strictness dflags full_laziness = dopt Opt_FullLaziness dflags @@ -701,18 +831,36 @@ getCoreToDo dflags spec_constr = dopt Opt_SpecConstr dflags liberate_case = dopt Opt_LiberateCase dflags rule_check = ruleCheck dflags + vectorisation = dopt Opt_Vectorise dflags + 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 + ] + + -- 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] ] - 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 [ + simpl_gently = CoreDoSimplify SimplGently [ -- Simplify "gently" -- Don't inline anything till full laziness has bitten -- In particular, inlining wrappers inhibits floating @@ -726,7 +874,26 @@ getCoreToDo dflags NoCaseOfCase, -- Don't do case-of-case transformations. -- This makes full laziness work better MaxSimplifierIterations max_iter - ], + ] + + core_todo = + if opt_level == 0 then + [runWhen vectorisation (CoreDoPasses [ simpl_gently, CoreDoVectorisation ]), + 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 CoreDoStaticArgs, + + -- initial simplify: mk specialiser happy: minimum effort please + simpl_gently, + + -- We run vectorisation here for now, but we might also try to run + -- it later + runWhen vectorisation (CoreDoPasses [ CoreDoVectorisation, simpl_gently ]), -- Specialisation is best done before full laziness -- so that overloaded functions have all their dictionary lambdas manifest @@ -736,29 +903,11 @@ getCoreToDo dflags 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 }, + simpl_phases, - 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. @@ -766,9 +915,8 @@ getCoreToDo dflags -- ==> 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), - ], - case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing }, #ifdef OLD_STRICTNESS CoreDoOldStrictness, @@ -777,9 +925,8 @@ getCoreToDo dflags CoreDoStrictness, CoreDoWorkerWrapper, CoreDoGlomBinds, - CoreDoSimplify (SimplPhase 0) [ - MaxSimplifierIterations max_iter - ]]), + simpl_phase 0 ["post-worker-wrapper"] max_iter + ]), runWhen full_laziness (CoreDoFloatOutwards (FloatOutSw False -- Not lambdas @@ -798,24 +945,23 @@ getCoreToDo dflags CoreDoFloatInwards, - case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing }, + 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, - CoreDoSimplify (SimplPhase 0) [ - MaxSimplifierIterations max_iter - ] ]), -- Run the simplifier after LiberateCase to vastly + 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: - CoreDoSimplify (SimplPhase 0) [ - MaxSimplifierIterations max_iter - ] + simpl_phase 0 ["final"] max_iter ] -- ----------------------------------------------------------------------------- @@ -848,10 +994,13 @@ allFlags :: [String] allFlags = map ('-':) $ [ name | (name, optkind) <- dynamic_flags, ok optkind ] ++ map ("fno-"++) flags ++ - map ("f"++) flags + map ("f"++) flags ++ + map ("X"++) xs ++ + map ("XNo"++) xs where ok (PrefixPred _ _) = False ok _ = True flags = map fst fFlags + xs = map fst xFlags dynamic_flags :: [(String, OptKind DynP)] dynamic_flags = [ @@ -871,6 +1020,7 @@ dynamic_flags = [ , ( "pgma" , HasArg (upd . setPgma) ) , ( "pgml" , HasArg (upd . setPgml) ) , ( "pgmdll" , HasArg (upd . setPgmdll) ) + , ( "pgmwindres" , HasArg (upd . setPgmwindres) ) , ( "optL" , HasArg (upd . addOptL) ) , ( "optP" , HasArg (upd . addOptP) ) @@ -879,8 +1029,8 @@ dynamic_flags = [ , ( "optm" , HasArg (upd . addOptm) ) , ( "opta" , HasArg (upd . addOpta) ) , ( "optl" , HasArg (upd . addOptl) ) - , ( "optdll" , HasArg (upd . addOptdll) ) , ( "optdep" , HasArg (upd . addOptdep) ) + , ( "optwindres" , HasArg (upd . addOptwindres) ) , ( "split-objs" , NoArg (if can_split then setDynFlag Opt_SplitObjs @@ -890,11 +1040,11 @@ dynamic_flags = [ , ( "c" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) , ( "no-link" , NoArg (upd $ \d -> d{ ghcLink=NoLink } )) -- Dep. , ( "shared" , NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } )) + , ( "dynload" , HasArg (upd . parseDynLibLoaderMode)) ------- Libraries --------------------------------------------------- , ( "L" , Prefix addLibraryPath ) - , ( "l" , AnySuffix (\s -> do upd (addOptl s) - upd (addOptdll s))) + , ( "l" , AnySuffix (\s -> do upd (addOptl s))) ------- Frameworks -------------------------------------------------- -- -framework-path should really be -F ... @@ -902,15 +1052,16 @@ dynamic_flags = [ , ( "framework" , HasArg (upd . addCmdlineFramework) ) ------- Output Redirection ------------------------------------------ - , ( "odir" , HasArg (upd . setObjectDir . Just)) + , ( "odir" , HasArg (upd . setObjectDir)) , ( "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)) + , ( "hidir" , HasArg (upd . setHiDir)) , ( "tmpdir" , HasArg (upd . setTmpDir)) - , ( "stubdir" , HasArg (upd . setStubDir . Just)) + , ( "stubdir" , HasArg (upd . setStubDir)) + , ( "ddump-file-prefix", HasArg (upd . setDumpPrefixForce . Just)) ------- Keeping temporary files ------------------------------------- -- These can be singular (think ghc -c) or plural (think ghc --make) @@ -927,6 +1078,7 @@ dynamic_flags = [ , ( "no-hs-main" , NoArg (setDynFlag Opt_NoHsMain)) , ( "main-is" , SepArg setMainIs ) , ( "haddock" , NoArg (setDynFlag Opt_Haddock) ) + , ( "haddock-opts" , HasArg (upd . addHaddockOpts)) , ( "hpcdir" , SepArg setOptHpcDir ) ------- recompilation checker (DEPRECATED, use -fforce-recomp) ----- @@ -955,8 +1107,19 @@ dynamic_flags = [ , ( "dstg-stats", NoArg (setDynFlag Opt_StgStats)) , ( "ddump-cmm", setDumpFlag Opt_D_dump_cmm) + , ( "ddump-cmmz", setDumpFlag Opt_D_dump_cmmz) + , ( "ddump-cmmz-pretty", setDumpFlag Opt_D_dump_cmmz_pretty) , ( "ddump-cps-cmm", setDumpFlag Opt_D_dump_cps_cmm) + , ( "ddump-cvt-cmm", setDumpFlag Opt_D_dump_cvt_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) @@ -969,6 +1132,7 @@ dynamic_flags = [ , ( "ddump-rn", setDumpFlag Opt_D_dump_rn) , ( "ddump-simpl", setDumpFlag Opt_D_dump_simpl) , ( "ddump-simpl-iterations", setDumpFlag Opt_D_dump_simpl_iterations) + , ( "ddump-simpl-phases", OptPrefix setDumpSimplPhases) , ( "ddump-spec", setDumpFlag Opt_D_dump_spec) , ( "ddump-prep", setDumpFlag Opt_D_dump_prep) , ( "ddump-stg", setDumpFlag Opt_D_dump_stg) @@ -987,18 +1151,21 @@ dynamic_flags = [ , ( "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-core2core", NoArg setVerboseCore2Core) , ( "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-hi-diffs", NoArg (setDynFlag Opt_D_dump_hi_diffs)) + , ( "ddump-view-pattern-commoning", setDumpFlag Opt_D_dump_view_pattern_commoning) + , ( "ddump-to-file", setDumpFlag Opt_DumpToFile) + , ( "ddump-hi-diffs", setDumpFlag Opt_D_dump_hi_diffs) + , ( "dcore-lint", NoArg (setDynFlag Opt_DoCoreLinting)) , ( "dstg-lint", NoArg (setDynFlag Opt_DoStgLinting)) , ( "dcmm-lint", NoArg (setDynFlag Opt_DoCmmLinting)) + , ( "dasm-lint", NoArg (setDynFlag Opt_DoAsmLinting)) , ( "dshow-passes", NoArg (do setDynFlag Opt_ForceRecomp setVerbosity (Just 2)) ) , ( "dfaststring-stats", NoArg (setDynFlag Opt_D_faststring_stats)) @@ -1009,103 +1176,163 @@ dynamic_flags = [ , ( "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 minusWallOpts) ) + ------ Warning opts ------------------------------------------------- + , ( "W" , NoArg (mapM_ setDynFlag minusWOpts) ) + , ( "Werror", NoArg (setDynFlag Opt_WarnIsError) ) + , ( "Wwarn" , NoArg (unSetDynFlag Opt_WarnIsError) ) + , ( "Wall" , NoArg (mapM_ setDynFlag minusWallOpts) ) + , ( "Wnot" , NoArg (mapM_ unSetDynFlag minusWallOpts) ) -- DEPRECATED + , ( "w" , NoArg (mapM_ unSetDynFlag minuswRemovesOpts) ) ------ Optimisation flags ------------------------------------------ , ( "O" , NoArg (upd (setOptLevel 1))) - , ( "Onot" , NoArg (upd (setOptLevel 0))) + , ( "Onot" , NoArg (upd (setOptLevel 0))) -- deprecated + , ( "Odph" , NoArg (upd setDPHOpt)) , ( "O" , OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1)))) -- If the number is missing, use 1 + , ( "fsimplifier-phases", IntSuffix (\n -> + upd (\dfs -> dfs{ simplPhases = n })) ) , ( "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 }))) + , ( "fspec-constr-threshold", IntSuffix (\n -> + upd (\dfs -> dfs{ specConstrThreshold = Just n }))) + , ( "fno-spec-constr-threshold", NoArg ( + upd (\dfs -> dfs{ specConstrThreshold = Nothing }))) + , ( "fspec-constr-count", IntSuffix (\n -> + upd (\dfs -> dfs{ specConstrCount = Just n }))) + , ( "fno-spec-constr-count", NoArg ( + upd (\dfs -> dfs{ specConstrCount = Nothing }))) + , ( "fliberate-case-threshold", IntSuffix (\n -> + upd (\dfs -> dfs{ liberateCaseThreshold = Just n }))) + , ( "fno-liberate-case-threshold", NoArg ( + upd (\dfs -> dfs{ liberateCaseThreshold = Nothing }))) + + , ( "frule-check", SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s }))) , ( "fcontext-stack" , IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n }) ------ Compiler flags ----------------------------------------------- - , ( "fasm", NoArg (setObjTarget HscAsm) ) - , ( "fvia-c", NoArg (setObjTarget HscC) ) - , ( "fvia-C", NoArg (setObjTarget HscC) ) + , ( "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) ) + , ( "fno-code", NoArg (setTarget HscNothing)) + , ( "fbyte-code", NoArg (setTarget HscInterpreted) ) + , ( "fobject-code", NoArg (setTarget defaultHscTarget) ) , ( "fglasgow-exts", NoArg (mapM_ setDynFlag glasgowExtsFlags) ) , ( "fno-glasgow-exts", NoArg (mapM_ unSetDynFlag glasgowExtsFlags) ) - -- the rest of the -f* and -fno-* flags - , ( "f", PrefixPred (isFlag fFlags) (\f -> setDynFlag (getFlag fFlags f)) ) - , ( "f", PrefixPred (isNoFlag fFlags) (\f -> unSetDynFlag (getNoFlag fFlags f)) ) - - -- For now, allow -X flags with -f; ToDo: report this as deprecated - , ( "f", PrefixPred (isFlag xFlags) (\f -> setDynFlag (getFlag xFlags f)) ) - , ( "f", PrefixPred (isNoFlag xFlags) (\f -> unSetDynFlag (getNoFlag xFlags f)) ) - - -- the rest of the -X* and -Xno-* flags - , ( "X", PrefixPred (isFlag xFlags) (\f -> setDynFlag (getFlag xFlags f)) ) - , ( "X", PrefixPred (isNoFlag xFlags) (\f -> unSetDynFlag (getNoFlag xFlags f)) ) + -- 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)) ) ] -- these -f flags can all be reversed with -fno- +fFlags :: [(String, DynFlag)] fFlags = [ - ( "warn-duplicate-exports", Opt_WarnDuplicateExports ), - ( "warn-hi-shadowing", Opt_WarnHiShadows ), + ( "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 ), - ( "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 ), + ( "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 ), + ( "static-argument-transformation", Opt_StaticArgumentTransformation ), + ( "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 ), + ( "do-eta-reduction", Opt_DoEtaReduction ), + ( "case-merge", Opt_CaseMerge ), + ( "unbox-strict-fields", Opt_UnboxStrictFields ), + ( "method-sharing", Opt_MethodSharing ), + ( "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 ) + ( "break-on-error", Opt_BreakOnError ), + ( "print-evld-with-show", Opt_PrintEvldWithShow ), + ( "print-bind-contents", Opt_PrintBindContents ), + ( "run-cps", Opt_RunCPSZ ), + ( "convert-to-zipper-and-back", Opt_ConvertToZipCfgAndBack), + ( "vectorise", Opt_Vectorise ), + ( "regs-graph", Opt_RegsGraph), + ( "regs-iterative", Opt_RegsIterative), + -- 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 ) ] +supportedLanguages :: [String] +supportedLanguages = map fst xFlags --- These -X flags can all be reversed with -Xno- +-- These -X flags can all be reversed with -XNo xFlags :: [(String, DynFlag)] xFlags = [ ( "CPP", Opt_Cpp ), @@ -1115,114 +1342,116 @@ xFlags = [ ( "PolymorphicComponents", Opt_PolymorphicComponents ), ( "ExistentialQuantification", Opt_ExistentialQuantification ), ( "KindSignatures", Opt_KindSignatures ), + ( "PatternSignatures", Opt_PatternSignatures ), ( "EmptyDataDecls", Opt_EmptyDataDecls ), ( "ParallelListComp", Opt_ParallelListComp ), - ( "FI", Opt_FFI ), -- support `-ffi'... - ( "FFI", Opt_FFI ), -- ...and also `-fffi' - ( "ForeignFunctionInterface", Opt_FFI ), - + ( "TransformListComp", Opt_TransformListComp ), + ( "ForeignFunctionInterface", Opt_ForeignFunctionInterface ), + ( "UnliftedFFITypes", Opt_UnliftedFFITypes ), + ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms ), ( "Rank2Types", Opt_Rank2Types ), ( "RankNTypes", Opt_RankNTypes ), + ( "ImpredicativeTypes", Opt_ImpredicativeTypes ), + ( "TypeOperators", Opt_TypeOperators ), ( "RecursiveDo", Opt_RecursiveDo ), - ( "Arrows", Opt_Arrows ), -- arrow syntax - ( "Parr", Opt_PArr ), - - ( "TH", Opt_TH ), -- support -fth - ( "TemplateHaskelll", Opt_TH ), - - ( "Generics", Opt_Generics ), - - ( "ImplicitPrelude", Opt_ImplicitPrelude ), -- On by default - - ( "RecordWildCards", Opt_RecordWildCards ), - ( "RecordPuns", Opt_RecordPuns ), - ( "DisambiguateRecordFields", Opt_DisambiguateRecordFields ), - - ( "OverloadedStrings", Opt_OverloadedStrings ), - ( "GADTs", Opt_GADTs ), - ( "TypeFamilies", Opt_TypeFamilies ), - ( "BangPatterns", Opt_BangPatterns ), - ( "MonomorphismRestriction", Opt_MonomorphismRestriction ), -- On by default - ( "MonoPatBinds", Opt_MonoPatBinds ), -- On by default (which is not strictly H98) - ( "RelaxedPolyRec", Opt_RelaxedPolyRec), - ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules ), - ( "ImplicitParams", Opt_ImplicitParams ), - ( "ScopedTypeVariables", Opt_ScopedTypeVariables ), - ( "TypeSynonymInstances", Opt_TypeSynonymInstances ), - ( "FlexibleInstances", Opt_FlexibleInstances ), - ( "MultiParamTypeClasses", Opt_MultiParamTypeClasses ), - ( "FunctionalDependencies", Opt_FunctionalDependencies ), - ( "GeneralizedNewtypeDeriving", Opt_GeneralizedNewtypeDeriving ), - ( "AllowOverlappingInstances", Opt_AllowOverlappingInstances ), - ( "AllowUndecidableInstances", Opt_AllowUndecidableInstances ), - ( "AllowIncoherentInstances", Opt_AllowIncoherentInstances ) + ( "Arrows", Opt_Arrows ), + ( "PArr", Opt_PArr ), + ( "TemplateHaskell", Opt_TemplateHaskell ), + ( "QuasiQuotes", Opt_QuasiQuotes ), + ( "Generics", Opt_Generics ), + -- On by default: + ( "ImplicitPrelude", Opt_ImplicitPrelude ), + ( "RecordWildCards", Opt_RecordWildCards ), + ( "RecordPuns", Opt_RecordPuns ), + ( "DisambiguateRecordFields", Opt_DisambiguateRecordFields ), + ( "OverloadedStrings", Opt_OverloadedStrings ), + ( "GADTs", Opt_GADTs ), + ( "ViewPatterns", Opt_ViewPatterns), + ( "TypeFamilies", Opt_TypeFamilies ), + ( "BangPatterns", Opt_BangPatterns ), + -- On by default: + ( "MonomorphismRestriction", Opt_MonomorphismRestriction ), + -- 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 ) ] 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 = [ Opt_GlasgowExts - , Opt_FFI - , Opt_GADTs - , Opt_ImplicitParams - , Opt_ScopedTypeVariables +glasgowExtsFlags :: [DynFlag] +glasgowExtsFlags = [ + Opt_PrintExplicitForalls + , Opt_ForeignFunctionInterface + , Opt_UnliftedFFITypes + , Opt_GADTs + , Opt_ImplicitParams + , Opt_ScopedTypeVariables + , Opt_UnboxedTuples , Opt_TypeSynonymInstances + , Opt_StandaloneDeriving + , Opt_DeriveDataTypeable + , Opt_FlexibleContexts , Opt_FlexibleInstances + , Opt_ConstrainedClassMethods , Opt_MultiParamTypeClasses , Opt_FunctionalDependencies - , Opt_MagicHash + , Opt_MagicHash , Opt_PolymorphicComponents , Opt_ExistentialQuantification , Opt_UnicodeSyntax , Opt_PatternGuards + , Opt_LiberalTypeSynonyms , Opt_RankNTypes + , Opt_ImpredicativeTypes + , Opt_TypeOperators , Opt_RecursiveDo , Opt_ParallelListComp , Opt_EmptyDataDecls , Opt_KindSignatures + , Opt_PatternSignatures , Opt_GeneralizedNewtypeDeriving - , Opt_TypeFamilies ] + , Opt_TypeFamilies ] ------------------ -isNoFlag, isFlag :: [(String,a)] -> String -> Bool - -isFlag flags f = is_flag flags (normaliseFlag f) +isFlag :: [(String,a)] -> String -> Bool +isFlag flags f = any (\(ff,_) -> ff == f) flags -isNoFlag flags no_f - | Just f <- noFlag_maybe (normaliseFlag no_f) = is_flag flags f - | otherwise = False - -is_flag flags nf = any (\(ff,_) -> normaliseFlag ff == nf) flags - -- nf is normalised alreadly +isPrefFlag :: String -> [(String,a)] -> String -> Bool +isPrefFlag pref flags no_f + | Just f <- maybePrefixMatch pref no_f = isFlag flags f + | otherwise = False ------------------ -getFlag, getNoFlag :: [(String,a)] -> String -> a - -getFlag flags f = get_flag flags (normaliseFlag f) - -getNoFlag flags f = get_flag flags (fromJust (noFlag_maybe (normaliseFlag f))) - -- The flag should be a no-flag already +getFlag :: [(String,a)] -> String -> a +getFlag flags f = case [ opt | (ff, opt) <- flags, ff == f] of + (o:_) -> o + [] -> panic ("get_flag " ++ f) -get_flag flags nf = case [ opt | (ff, opt) <- flags, normaliseFlag ff == nf] of - (o:os) -> o - [] -> panic ("get_flag " ++ nf) - ------------------- -noFlag_maybe :: String -> Maybe String --- The input is normalised already -noFlag_maybe ('n' : 'o' : f) = Just f -noFlag_maybe other = Nothing - -normaliseFlag :: String -> String --- Normalise a option flag by --- * map to lower case --- * removing hyphens --- Thus: -X=overloaded-strings or -XOverloadedStrings -normaliseFlag [] = [] -normaliseFlag ('-':s) = normaliseFlag s -normaliseFlag (c:s) = toLower c : normaliseFlag s +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 -- ----------------------------------------------------------------------------- -- Parsing the dynamic flags. @@ -1257,17 +1486,64 @@ unSetDynFlag f = upd (\dfs -> dopt_unset dfs f) -------------------------- setDumpFlag :: DynFlag -> OptKind DynP setDumpFlag dump_flag - = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag 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, hidePackage, ignorePackage :: String -> DynP () exposePackage p = upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s }) hidePackage p = @@ -1275,6 +1551,7 @@ hidePackage 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")) @@ -1285,6 +1562,7 @@ 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 @@ -1295,6 +1573,7 @@ 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 @@ -1311,23 +1590,44 @@ setOptLevel 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 + + + 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 main_mod) -- The arg looked like "Foo" - = upd $ \d -> d{ 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) } | otherwise -- The arg looked like "baz" - = upd $ \d -> d{ mainFunIs = Just main_mod } + = 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}) @@ -1342,7 +1642,10 @@ addIncludePath 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) @@ -1386,7 +1689,7 @@ splitPathList s = filter notNull (splitUp s) -- finding the next split marker. findNextPath xs = case break (`elem` split_markers) xs of - (p, d:ds) -> (p, ds) + (p, _:ds) -> (p, ds) (p, xs) -> (p, xs) split_markers :: [Char] @@ -1400,36 +1703,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 @@ -1440,9 +1716,21 @@ setOptHpcDir arg = upd $ \ d -> d{hpcDir = arg} ----------------------------------------------------------------------------- -- Via-C compilation stuff +-- There are some options that we need to pass to gcc when compiling +-- Haskell code via C, but are only supported by recent versions of +-- gcc. The configure script decides which of these options we need, +-- and puts them in the file "extra-gcc-opts" in $topdir, which is +-- read before each via-C compilation. The advantage of having these +-- in a separate file is that the file can be created at install-time +-- depending on the available gcc version, and even re-generated later +-- if gcc is upgraded. +-- +-- The options below are not dependent on the version of gcc, only the +-- platform. + machdepCCOpts :: DynFlags -> ([String], -- flags for all C compilations [String]) -- for registerised HC compilations -machdepCCOpts dflags +machdepCCOpts _dflags #if alpha_TARGET_ARCH = ( ["-w", "-mieee" #ifdef HAVE_THREADED_RTS_SUPPORT @@ -1475,27 +1763,13 @@ machdepCCOpts dflags -- -- -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 + = 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", -#ifdef HAVE_GCC_MNO_OMIT_LFPTR - -- Some gccs are configured with - -- -momit-leaf-frame-pointer on by default, and it - -- apparently takes precedence over - -- -fomit-frame-pointer, so we disable it first here. - "-mno-omit-leaf-frame-pointer", -#endif -#ifdef HAVE_GCC_HAS_NO_UNIT_AT_A_TIME - "-fno-unit-at-a-time", - -- unit-at-a-time doesn't do us any good, and screws - -- up -split-objs by moving the split markers around. - -- It's only turned on with -O2, but put it here just - -- in case someone uses -optc-O2. -#endif "-fomit-frame-pointer", -- we want -fno-builtin, because when gcc inlines -- built-in functions like memcpy() it tends to @@ -1514,13 +1788,6 @@ machdepCCOpts dflags -- and get in the way of -split-objs. Another option -- would be to throw them away in the mangler, but this -- is easier. -#ifdef HAVE_GCC_HAS_NO_UNIT_AT_A_TIME - "-fno-unit-at-a-time", - -- unit-at-a-time doesn't do us any good, and screws - -- up -split-objs by moving the split markers around. - -- It's only turned on with -O2, but put it here just - -- in case someone uses -optc-O2. -#endif "-fno-builtin" -- calling builtins like strlen() using the FFI can -- cause gcc to run out of regs, so use the external @@ -1544,7 +1811,7 @@ machdepCCOpts dflags #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. @@ -1555,15 +1822,18 @@ picCCOpts dflags -- in dynamic libraries. | opt_PIC - = ["-fno-common"] + = ["-fno-common", "-D__PIC__"] | otherwise = ["-mdynamic-no-pic"] #elif mingw32_TARGET_OS -- no -fPIC for Windows + | opt_PIC + = ["-D__PIC__"] + | otherwise = [] #else | opt_PIC - = ["-fPIC"] + = ["-fPIC", "-D__PIC__"] | otherwise = [] #endif @@ -1572,18 +1842,24 @@ picCCOpts dflags -- Splitting can_split :: Bool -can_split = -#if defined(i386_TARGET_ARCH) \ - || defined(x86_64_TARGET_ARCH) \ - || defined(alpha_TARGET_ARCH) \ - || defined(hppa_TARGET_ARCH) \ - || defined(m68k_TARGET_ARCH) \ - || defined(mips_TARGET_ARCH) \ - || defined(powerpc_TARGET_ARCH) \ - || defined(rs6000_TARGET_ARCH) \ - || defined(sparc_TARGET_ARCH) - True -#else - False -#endif +can_split = cSplitObjs == "YES" + +-- ----------------------------------------------------------------------------- +-- Compiler Info + +compilerInfo :: [(String, String)] +compilerInfo = [("Project name", cProjectName), + ("Project version", cProjectVersion), + ("Booter version", cBooterVersion), + ("Stage", cStage), + ("Interface file version", cHscIfaceFileVersion), + ("Have interpreter", cGhcWithInterpreter), + ("Object splitting", cSplitObjs), + ("Have native code generator", cGhcWithNativeCodeGen), + ("Support SMP", cGhcWithSMP), + ("Unregisterised", cGhcUnregisterised), + ("Tables next to code", cGhcEnableTablesNextToCode), + ("Win32 DLLs", cEnableWin32DLLs), + ("RTS ways", cGhcRTSWays), + ("Leading underscore", cLeadingUnderscore)]