X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=34227087dd54b71f0f9ce29f8d03724bf578afae;hb=5a8066e3ee6bc074d09b10929b9e643b78d2d9fe;hp=37f1171eec6af12315665058617f2891dfe0848d;hpb=269949584b7c124e95543c5c006822db4cec4d8b;p=ghc-hetmet.git diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 37f1171..3422708 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -17,10 +17,11 @@ module DynFlags ( GhcMode(..), isOneShot, GhcLink(..), isNoLink, PackageFlag(..), - Option(..), + Option(..), showOpt, DynLibLoader(..), fFlags, xFlags, dphPackage, + wayNames, -- ** Manipulating DynFlags defaultDynFlags, -- DynFlags @@ -45,18 +46,12 @@ module DynFlags ( -- ** DynFlag C compiler options machdepCCOpts, picCCOpts, - -- * Configuration of the core-to-core passes - CoreToDo(..), - SimplifierMode(..), - SimplifierSwitch(..), - FloatOutSwitches(..), - getCoreToDo, - -- * Configuration of the stg-to-stg passes StgToDo(..), getStgToDo, -- * Compiler configuration suitable for display to the user + Printable(..), compilerInfo ) where @@ -68,18 +63,13 @@ import Platform import Module import PackageConfig import PrelNames ( mAIN ) -#if defined(i386_TARGET_ARCH) || (!defined(mingw32_TARGET_OS) && !defined(darwin_TARGET_OS)) -import StaticFlags ( opt_Static ) -#endif -import StaticFlags ( opt_PIC, WayName(..), v_Ways, v_Build_tag, - v_RTS_Build_tag ) +import StaticFlags import {-# SOURCE #-} Packages (PackageState) import DriverPhases ( Phase(..), phaseInputExt ) import Config import CmdLineParser import Constants ( mAX_CONTEXT_REDUCTION_DEPTH ) import Panic -import UniqFM ( UniqFM ) import Util import Maybes ( orElse ) import SrcLoc @@ -117,6 +107,8 @@ data DynFlag | Opt_D_dump_asm_conflicts | Opt_D_dump_asm_stats | Opt_D_dump_asm_expanded + | Opt_D_dump_llvm + | Opt_D_dump_llvm_opt | Opt_D_dump_cpranal | Opt_D_dump_deriv | Opt_D_dump_ds @@ -185,6 +177,7 @@ data DynFlag | Opt_WarnUnusedMatches | Opt_WarnWarningsDeprecations | Opt_WarnDeprecatedFlags + | Opt_WarnDodgyExports | Opt_WarnDodgyImports | Opt_WarnOrphans | Opt_WarnTabs @@ -193,6 +186,7 @@ data DynFlag | Opt_WarnLazyUnliftedBindings | Opt_WarnUnusedDoBind | Opt_WarnWrongDoBind + | Opt_WarnAlternativeLayoutRuleTransitional -- language opts @@ -224,6 +218,7 @@ data DynFlag | Opt_ViewPatterns | Opt_GADTs | Opt_RelaxedPolyRec + | Opt_NPlusKPatterns | Opt_StandaloneDeriving | Opt_DeriveDataTypeable @@ -247,7 +242,9 @@ data DynFlag | Opt_TransformListComp | Opt_GeneralizedNewtypeDeriving | Opt_RecursiveDo + | Opt_DoRec | Opt_PostfixOperators + | Opt_TupleSections | Opt_PatternGuards | Opt_LiberalTypeSynonyms | Opt_Rank2Types @@ -256,18 +253,21 @@ data DynFlag | Opt_TypeOperators | Opt_PackageImports | Opt_NewQualifiedOperators + | Opt_ExplicitForAll + | Opt_AlternativeLayoutRule + | Opt_AlternativeLayoutRuleTransitional | Opt_PrintExplicitForalls -- optimisation opts | Opt_Strictness | Opt_FullLaziness + | Opt_FloatIn + | Opt_Specialise | Opt_StaticArgumentTransformation | Opt_CSE | Opt_LiberateCase | Opt_SpecConstr - | Opt_IgnoreInterfacePragmas - | Opt_OmitInterfacePragmas | Opt_DoLambdaEtaExpansion | Opt_IgnoreAsserts | Opt_DoEtaReduction @@ -275,12 +275,16 @@ data DynFlag | Opt_UnboxStrictFields | Opt_MethodSharing | Opt_DictsCheap - | Opt_InlineIfEnoughArgs | Opt_EnableRewriteRules -- Apply rewrite rules during simplification | Opt_Vectorise | Opt_RegsGraph -- do graph coloring register allocation | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation + -- Interface files + | Opt_IgnoreInterfacePragmas + | Opt_OmitInterfacePragmas + | Opt_ExposeAllUnfoldings + -- profiling opts | Opt_AutoSccsOnAllToplevs | Opt_AutoSccsOnExportedToplevs @@ -296,6 +300,7 @@ data DynFlag | Opt_EagerBlackHoling | Opt_ReadUserPackageConf | Opt_NoHsMain + | Opt_RtsOptsEnabled | Opt_SplitObjs | Opt_StgStats | Opt_HideAllPackages @@ -311,6 +316,8 @@ data DynFlag | Opt_EmbedManifest | Opt_EmitExternalCore | Opt_SharedImplib + | Opt_BuildingCabalPackage + | Opt_SSE2 -- temporary flags | Opt_RunCPS @@ -327,6 +334,7 @@ data DynFlag | Opt_KeepRawSFiles | Opt_KeepTmpFiles | Opt_KeepRawTokenStream + | Opt_KeepLlvmFiles deriving (Eq, Show) @@ -335,17 +343,16 @@ data DynFlag 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 .hcr output file - verbosity :: Int, -- ^ Verbosity level: see "DynFlags#verbosity_levels" + verbosity :: Int, -- ^ Verbosity level: see Note [Verbosity levels] optLevel :: Int, -- ^ Optimisation level simplPhases :: Int, -- ^ Number of simplifier phases maxSimplIterations :: Int, -- ^ Max simplifier iterations - shouldDumpSimplPhase :: SimplifierMode -> Bool, + shouldDumpSimplPhase :: Maybe String, ruleCheck :: Maybe String, + strictnessBefore :: [Int], -- ^ Additional demand analysis specConstrThreshold :: Maybe Int, -- ^ Threshold for SpecConstr specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function @@ -366,7 +373,7 @@ data DynFlags = DynFlags { thisPackage :: PackageId, -- ^ name of package currently being compiled -- ways - wayNames :: [WayName], -- ^ Way flags from the command line + ways :: [Way], -- ^ Way flags from the command line buildTag :: String, -- ^ The global \"way\" (e.g. \"p\" for prof) rtsBuildTag :: String, -- ^ The RTS \"way\" @@ -375,6 +382,7 @@ data DynFlags = DynFlags { -- paths etc. objectDir :: Maybe String, + dylibInstallName :: Maybe String, hiDir :: Maybe String, stubDir :: Maybe String, @@ -402,6 +410,7 @@ data DynFlags = DynFlags { ghcUsagePath :: FilePath, -- Filled in by SysTools ghciUsagePath :: FilePath, -- ditto + rtsOpts :: Maybe String, hpcDir :: String, -- ^ Path to store the .mix files @@ -414,6 +423,9 @@ data DynFlags = DynFlags { opt_a :: [String], opt_l :: [String], opt_windres :: [String], + opt_la :: [String], -- LLVM: llvm-as assembler + opt_lo :: [String], -- LLVM: llvm optimiser + opt_lc :: [String], -- LLVM: llc static compiler -- commands for particular phases pgm_L :: String, @@ -428,6 +440,9 @@ data DynFlags = DynFlags { pgm_T :: String, pgm_sysman :: String, pgm_windres :: String, + pgm_la :: (String,[Option]), -- LLVM: llvm-as assembler + pgm_lo :: (String,[Option]), -- LLVM: opt llvm optimiser + pgm_lc :: (String,[Option]), -- LLVM: llc static compiler -- For ghc -M depMakefile :: FilePath, @@ -448,7 +463,7 @@ data DynFlags = DynFlags { -- Package state -- NB. do not modify this field, it is calculated by -- Packages.initPackages and Packages.updatePackages. - pkgDatabase :: Maybe (UniqFM PackageConfig), + pkgDatabase :: Maybe [PackageConfig], pkgState :: PackageState, -- Temporary files @@ -466,6 +481,9 @@ data DynFlags = DynFlags { haddockOptions :: Maybe String } +wayNames :: DynFlags -> [WayName] +wayNames = map wayName . ways + -- | The target code type of the compilation (if any). -- -- Whenever you change the target, also make sure to set 'ghcLink' to @@ -489,6 +507,7 @@ data DynFlags = DynFlags { data HscTarget = HscC -- ^ Generate C code. | HscAsm -- ^ Generate assembly using the native code generator. + | HscLlvm -- ^ Generate assembly using the llvm code generator. | HscJava -- ^ Generate Java bytecode. | HscInterpreted -- ^ Generate bytecode. (Requires 'LinkInMemory') | HscNothing -- ^ Don't generate any code. See notes above. @@ -498,6 +517,7 @@ data HscTarget isObjectTarget :: HscTarget -> Bool isObjectTarget HscC = True isObjectTarget HscAsm = True +isObjectTarget HscLlvm = True isObjectTarget _ = False -- | The 'GhcMode' tells us whether we're doing multi-module @@ -537,10 +557,13 @@ isNoLink _ = False -- Is it worth evaluating this Bool and caching it in the DynFlags value -- during initDynFlags? doingTickyProfiling :: DynFlags -> Bool -doingTickyProfiling dflags = WayTicky `elem` wayNames dflags +doingTickyProfiling _ = opt_Ticky + -- XXX -ticky is a static flag, because it implies -debug which is also + -- static. If the way flags were made dynamic, we could fix this. data PackageFlag = ExposePackage String + | ExposePackageId String | HidePackage String | IgnorePackage String deriving Eq @@ -566,14 +589,12 @@ 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 refFilesToClean <- newIORef [] refDirsToClean <- newIORef emptyFM return dflags{ - wayNames = ways, - buildTag = build_tag, - rtsBuildTag = rts_build_tag, + ways = ways, + buildTag = mkBuildTag (filter (not . wayRTSOnly) ways), + rtsBuildTag = mkBuildTag ways, filesToClean = refFilesToClean, dirsToClean = refDirsToClean } @@ -585,8 +606,6 @@ defaultDynFlags = DynFlags { ghcMode = CompManager, ghcLink = LinkBinary, - coreToDo = Nothing, - stgToDo = Nothing, hscTarget = defaultHscTarget, hscOutName = "", extCoreName = "", @@ -594,11 +613,13 @@ defaultDynFlags = optLevel = 0, simplPhases = 2, maxSimplIterations = 4, - shouldDumpSimplPhase = const False, + shouldDumpSimplPhase = Nothing, ruleCheck = Nothing, specConstrThreshold = Just 200, specConstrCount = Just 3, liberateCaseThreshold = Just 200, + strictnessBefore = [], + #ifndef OMIT_NATIVE_CODEGEN targetPlatform = defaultTargetPlatform, #endif @@ -614,6 +635,7 @@ defaultDynFlags = thisPackage = mainPackageId, objectDir = Nothing, + dylibInstallName = Nothing, hiDir = Nothing, stubDir = Nothing, @@ -631,6 +653,7 @@ defaultDynFlags = frameworkPaths = [], cmdlineFrameworks = [], tmpDir = cDEFAULT_TMPDIR, + rtsOpts = Nothing, hpcDir = ".hpc", @@ -644,12 +667,15 @@ defaultDynFlags = opt_m = [], opt_l = [], opt_windres = [], + opt_la = [], + opt_lo = [], + opt_lc = [], extraPkgConfs = [], packageFlags = [], pkgDatabase = Nothing, pkgState = panic "no package state yet: call GHC.setSessionDynFlags", - wayNames = panic "defaultDynFlags: No wayNames", + ways = panic "defaultDynFlags: No ways", buildTag = panic "defaultDynFlags: No buildTag", rtsBuildTag = panic "defaultDynFlags: No rtsBuildTag", splitInfo = Nothing, @@ -670,6 +696,9 @@ defaultDynFlags = pgm_T = panic "defaultDynFlags: No pgm_T", pgm_sysman = panic "defaultDynFlags: No pgm_sysman", pgm_windres = panic "defaultDynFlags: No pgm_windres", + pgm_la = panic "defaultDynFlags: No pgm_la", + pgm_lo = panic "defaultDynFlags: No pgm_lo", + pgm_lc = panic "defaultDynFlags: No pgm_lc", -- end of initSysTools values -- ghc -M values depMakefile = "Makefile", @@ -690,6 +719,7 @@ defaultDynFlags = Opt_ImplicitPrelude, Opt_MonomorphismRestriction, + Opt_NPlusKPatterns, Opt_MethodSharing, @@ -718,9 +748,8 @@ defaultDynFlags = } {- - #verbosity_levels# - Verbosity levels: - +Note [Verbosity levels] +~~~~~~~~~~~~~~~~~~~~~~~ 0 | print errors & warnings only 1 | minimal verbosity: print "compiling M ... done." for each module. 2 | equivalent to -dshow-passes @@ -755,11 +784,12 @@ getVerbFlag dflags | verbosity dflags >= 3 = "-v" | otherwise = "" -setObjectDir, setHiDir, setStubDir, setOutputDir, +setObjectDir, setHiDir, setStubDir, setOutputDir, setDylibInstallName, setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode, setPgmP, setPgmL, setPgmF, setPgmc, setPgmm, setPgms, setPgma, setPgml, setPgmdll, setPgmwindres, - addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres, - addCmdlineFramework, addHaddockOpts + setPgmla, setPgmlo, setPgmlc, + addOptL, addOptP, addOptF, addOptc, addOptm, addOpta, addOptl, addOptwindres, addOptla, addOptlo, + addOptlc, addCmdlineFramework, addHaddockOpts :: String -> DynFlags -> DynFlags setOutputFile, setOutputHi, setDumpPrefixForce :: Maybe String -> DynFlags -> DynFlags @@ -770,6 +800,7 @@ 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. setOutputDir f = setObjectDir f . setHiDir f . setStubDir f +setDylibInstallName f d = d{ dylibInstallName = Just f} setObjectSuf f d = d{ objectSuf = f} setHiSuf f d = d{ hiSuf = f} @@ -802,6 +833,9 @@ 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} +setPgmla f d = d{ pgm_la = (f,[])} +setPgmlo f d = d{ pgm_lo = (f,[])} +setPgmlc f d = d{ pgm_lc = (f,[])} addOptL f d = d{ opt_L = f : opt_L d} addOptP f d = d{ opt_P = f : opt_P d} @@ -811,6 +845,9 @@ 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} addOptwindres f d = d{ opt_windres = f : opt_windres d} +addOptla f d = d{ opt_la = f : opt_la d} +addOptlo f d = d{ opt_lo = f : opt_lo d} +addOptlc f d = d{ opt_lc = f : opt_lc d} setDepMakefile :: FilePath -> DynFlags -> DynFlags setDepMakefile f d = d { depMakefile = deOptDep f } @@ -853,6 +890,10 @@ data Option String -- the filepath/filename portion | Option String +showOpt :: Option -> String +showOpt (FileOption pre f) = pre ++ f +showOpt (Option s) = s + ----------------------------------------------------------------------------- -- Setting the optimisation level @@ -881,6 +922,8 @@ optLevelFlags , ([1,2], Opt_Strictness) , ([1,2], Opt_CSE) , ([1,2], Opt_FullLaziness) + , ([1,2], Opt_Specialise) + , ([1,2], Opt_FloatIn) , ([2], Opt_LiberateCase) , ([2], Opt_SpecConstr) @@ -916,7 +959,8 @@ standardWarnings Opt_WarnDuplicateExports, Opt_WarnLazyUnliftedBindings, Opt_WarnDodgyForeignImports, - Opt_WarnWrongDoBind + Opt_WarnWrongDoBind, + Opt_WarnAlternativeLayoutRuleTransitional ] minusWOpts :: [DynFlag] @@ -926,6 +970,7 @@ minusWOpts Opt_WarnUnusedMatches, Opt_WarnUnusedImports, Opt_WarnIncompletePatterns, + Opt_WarnDodgyExports, Opt_WarnDodgyImports ] @@ -953,242 +998,6 @@ 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. - - = 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 - | CoreDoPrintCore - | CoreDoStaticArgs - | CoreDoStrictness - | CoreDoWorkerWrapper - | CoreDoSpecialising - | CoreDoSpecConstr - | CoreDoOldStrictness - | CoreDoGlomBinds - | CoreCSE - | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules - -- matching this string - | CoreDoVectorisation PackageId - | CoreDoNothing -- Useful when building up - | CoreDoPasses [CoreToDo] -- lists of these things - - -data SimplifierMode -- See comments in SimplMonad - = SimplGently - | SimplPhase Int [String] - -instance Outputable SimplifierMode where - ppr SimplGently = ptext (sLit "gentle") - ppr (SimplPhase n ss) = int n <+> brackets (text (concat $ intersperse "," ss)) - - -data SimplifierSwitch - = MaxSimplifierIterations Int - | NoCaseOfCase - - -data FloatOutSwitches = FloatOutSwitches { - floatOutLambdas :: Bool, -- ^ True <=> float lambdas to top level - floatOutConstants :: Bool -- ^ True <=> float constants to top level, - -- even if they do not escape a lambda - } - -instance Outputable FloatOutSwitches where - ppr = pprFloatOutSwitches - -pprFloatOutSwitches :: FloatOutSwitches -> SDoc -pprFloatOutSwitches sw = pp_not (floatOutLambdas sw) <+> text "lambdas" <> comma - <+> pp_not (floatOutConstants sw) <+> text "constants" - where - pp_not True = empty - pp_not False = text "not" - --- | Switches that specify the minimum amount of floating out --- gentleFloatOutSwitches :: FloatOutSwitches --- gentleFloatOutSwitches = FloatOutSwitches False False - --- | Switches that do not specify floating out of lambdas, just of constants -constantsOnlyFloatOutSwitches :: FloatOutSwitches -constantsOnlyFloatOutSwitches = FloatOutSwitches False True - - --- The core-to-core pass ordering is derived from the DynFlags: -runWhen :: Bool -> CoreToDo -> CoreToDo -runWhen True do_this = do_this -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 - 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 - 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 (dphPackage 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 - [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 - 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 constantsOnlyFloatOutSwitches), - -- Was: gentleFloatOutSwitches - -- I have no idea why, but not floating constants to top level is - -- very bad in some cases. - -- Notably: p_ident in spectral/rewrite - -- Changing from "gentle" to "constantsOnly" improved - -- rewrite's allocation by 19%, and made 0.0% difference - -- to any other nofib benchmark - - 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, -#endif - runWhen strictness (CoreDoPasses [ - CoreDoStrictness, - CoreDoWorkerWrapper, - CoreDoGlomBinds, - simpl_phase 0 ["post-worker-wrapper"] max_iter - ]), - - runWhen full_laziness - (CoreDoFloatOutwards constantsOnlyFloatOutSwitches), - -- 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 - ] - --- ----------------------------------------------------------------------------- -- StgToDo: abstraction of stg-to-stg passes to run. data StgToDo @@ -1199,8 +1008,7 @@ data StgToDo getStgToDo :: DynFlags -> [StgToDo] getStgToDo dflags - | Just todo <- stgToDo dflags = todo -- set explicitly by user - | otherwise = todo2 + = todo2 where stg_stats = dopt Opt_StgStats dflags @@ -1219,8 +1027,7 @@ allFlags = map ('-':) $ [ flagName flag | flag <- dynamic_flags, ok (flagOptKind flag) ] ++ map ("fno-"++) flags ++ map ("f"++) flags ++ - map ("X"++) supportedLanguages ++ - map ("XNo"++) supportedLanguages + map ("X"++) supportedLanguages where ok (PrefixPred _ _) = False ok _ = True flags = [ name | (name, _, _) <- fFlags ] @@ -1230,10 +1037,16 @@ dynamic_flags = [ 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 "#include" (HasArg (addCmdlineHCInclude)) + (DeprecatedFullText "-#include and INCLUDE pragmas are deprecated: They no longer have any effect") , Flag "v" (OptIntSuffix setVerbosity) Supported ------- Specific phases -------------------------------------------- + -- need to appear before -pgmL to be parsed as LLVM flags. + , Flag "pgmla" (HasArg (upd . setPgmla)) Supported + , Flag "pgmlo" (HasArg (upd . setPgmlo)) Supported + , Flag "pgmlc" (HasArg (upd . setPgmlc)) Supported + , Flag "pgmL" (HasArg (upd . setPgmL)) Supported , Flag "pgmP" (HasArg (upd . setPgmP)) Supported , Flag "pgmF" (HasArg (upd . setPgmF)) Supported @@ -1245,6 +1058,11 @@ dynamic_flags = [ , Flag "pgmdll" (HasArg (upd . setPgmdll)) Supported , Flag "pgmwindres" (HasArg (upd . setPgmwindres)) Supported + -- need to appear before -optl/-opta to be parsed as LLVM flags. + , Flag "optla" (HasArg (upd . addOptla)) Supported + , Flag "optlo" (HasArg (upd . addOptlo)) Supported + , Flag "optlc" (HasArg (upd . addOptlc)) Supported + , Flag "optL" (HasArg (upd . addOptL)) Supported , Flag "optP" (HasArg (upd . addOptP)) Supported , Flag "optF" (HasArg (upd . addOptF)) Supported @@ -1279,14 +1097,13 @@ dynamic_flags = [ (Deprecated "Use -exclude-module instead") -------- Linking ---------------------------------------------------- - , Flag "c" (NoArg (upd $ \d -> d{ ghcLink=NoLink } )) - Supported , Flag "no-link" (NoArg (upd $ \d -> d{ ghcLink=NoLink } )) - (Deprecated "Use -c instead") + Supported , Flag "shared" (NoArg (upd $ \d -> d{ ghcLink=LinkDynLib } )) Supported , Flag "dynload" (HasArg (upd . parseDynLibLoaderMode)) Supported + , Flag "dylib-install-name" (HasArg (upd . setDylibInstallName)) Supported ------- Libraries --------------------------------------------------- , Flag "L" (Prefix addLibraryPath ) Supported @@ -1319,12 +1136,17 @@ dynamic_flags = [ , 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 + , Flag "keep-llvm-file" (NoArg (setDynFlag Opt_KeepLlvmFiles)) Supported + , Flag "keep-llvm-files" (NoArg (setDynFlag Opt_KeepLlvmFiles)) Supported -- This only makes sense as plural , 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 "with-rtsopts" (HasArg setRtsOpts) Supported + , Flag "rtsopts" (NoArg (setDynFlag Opt_RtsOptsEnabled)) Supported + , Flag "no-rtsopts" (NoArg (unSetDynFlag Opt_RtsOptsEnabled)) Supported , Flag "main-is" (SepArg setMainIs ) Supported , Flag "haddock" (NoArg (setDynFlag Opt_Haddock)) Supported , Flag "haddock-opts" (HasArg (upd . addHaddockOpts)) Supported @@ -1376,6 +1198,11 @@ dynamic_flags = [ Supported , Flag "ddump-asm-expanded" (setDumpFlag Opt_D_dump_asm_expanded) Supported + , Flag "ddump-llvm" (NoArg (do { setObjTarget HscLlvm + ; setDumpFlag' Opt_D_dump_llvm})) + Supported + , Flag "ddump-opt-llvm" (setDumpFlag Opt_D_dump_llvm_opt) + Supported , Flag "ddump-cpranal" (setDumpFlag Opt_D_dump_cpranal) Supported , Flag "ddump-deriv" (setDumpFlag Opt_D_dump_deriv) @@ -1438,7 +1265,8 @@ dynamic_flags = [ Supported , Flag "dsource-stats" (setDumpFlag Opt_D_source_stats) Supported - , Flag "dverbose-core2core" (NoArg setVerboseCore2Core) + , Flag "dverbose-core2core" (NoArg (do { setVerbosity (Just 2) + ; setVerboseCore2Core })) Supported , Flag "dverbose-stg2stg" (setDumpFlag Opt_D_verbose_stg2stg) Supported @@ -1485,6 +1313,9 @@ dynamic_flags = [ , Flag "monly-4-regs" (NoArg (upd (\s -> s{stolen_x86_regs = 4}) )) Supported + , Flag "msse2" (NoArg (setDynFlag Opt_SSE2)) + Supported + ------ Warning opts ------------------------------------------------- , Flag "W" (NoArg (mapM_ setDynFlag minusWOpts)) Supported @@ -1541,6 +1372,10 @@ dynamic_flags = [ (IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n }) Supported + , Flag "fstrictness-before" + (IntSuffix (\n -> upd (\dfs -> dfs{ strictnessBefore = n : strictnessBefore dfs }))) + Supported + ------ Profiling ---------------------------------------------------- -- XXX Should the -f* flags be deprecated? @@ -1588,10 +1423,15 @@ dynamic_flags = [ ------ Compiler flags ----------------------------------------------- , Flag "fasm" (NoArg (setObjTarget HscAsm)) Supported - , Flag "fvia-c" (NoArg (setObjTarget HscC)) Supported - , Flag "fvia-C" (NoArg (setObjTarget HscC)) Supported - - , Flag "fno-code" (NoArg (setTarget HscNothing)) Supported + , Flag "fvia-c" (NoArg (setObjTarget HscC)) + (Deprecated "The -fvia-c flag will be removed in a future GHC release") + , Flag "fvia-C" (NoArg (setObjTarget HscC)) + (Deprecated "The -fvia-C flag will be removed in a future GHC release") + , Flag "fllvm" (NoArg (setObjTarget HscLlvm)) Supported + + , Flag "fno-code" (NoArg (do upd $ \d -> d{ ghcLink=NoLink } + setTarget HscNothing)) + Supported , Flag "fbyte-code" (NoArg (setTarget HscInterpreted)) Supported , Flag "fobject-code" (NoArg (setTarget defaultHscTarget)) Supported @@ -1612,6 +1452,7 @@ package_flags = [ , Flag "no-user-package-conf" (NoArg (unSetDynFlag Opt_ReadUserPackageConf)) Supported , Flag "package-name" (HasArg (upd . setPackageName)) Supported + , Flag "package-id" (HasArg exposePackageId) Supported , Flag "package" (HasArg exposePackage) Supported , Flag "hide-package" (HasArg hidePackage) Supported , Flag "hide-all-packages" (NoArg (setDynFlag Opt_HideAllPackages)) @@ -1632,7 +1473,7 @@ mkFlag turnOn flagPrefix f (name, dynflag, deprecated) deprecatedForLanguage :: String -> Bool -> Deprecated deprecatedForLanguage lang turn_on - = Deprecated ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ "#-} instead") + = Deprecated ("use -X" ++ flag ++ " or pragma {-# LANGUAGE " ++ flag ++ " #-} instead") where flag | turn_on = lang | otherwise = "No"++lang @@ -1647,6 +1488,7 @@ useInstead flag turn_on fFlags :: [(String, DynFlag, Bool -> Deprecated)] fFlags = [ ( "warn-dodgy-foreign-imports", Opt_WarnDodgyForeignImports, const Supported ), + ( "warn-dodgy-exports", Opt_WarnDodgyExports, const Supported ), ( "warn-dodgy-imports", Opt_WarnDodgyImports, const Supported ), ( "warn-duplicate-exports", Opt_WarnDuplicateExports, const Supported ), ( "warn-hi-shadowing", Opt_WarnHiShadows, const Supported ), @@ -1674,8 +1516,11 @@ fFlags = [ const $ Deprecated "lazy unlifted bindings will be an error in GHC 6.14, and this flag will no longer exist"), ( "warn-unused-do-bind", Opt_WarnUnusedDoBind, const Supported ), ( "warn-wrong-do-bind", Opt_WarnWrongDoBind, const Supported ), + ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, const Supported ), ( "print-explicit-foralls", Opt_PrintExplicitForalls, const Supported ), ( "strictness", Opt_Strictness, const Supported ), + ( "specialise", Opt_Specialise, const Supported ), + ( "float-in", Opt_FloatIn, const Supported ), ( "static-argument-transformation", Opt_StaticArgumentTransformation, const Supported ), ( "full-laziness", Opt_FullLaziness, const Supported ), ( "liberate-case", Opt_LiberateCase, const Supported ), @@ -1683,6 +1528,7 @@ fFlags = [ ( "cse", Opt_CSE, const Supported ), ( "ignore-interface-pragmas", Opt_IgnoreInterfacePragmas, const Supported ), ( "omit-interface-pragmas", Opt_OmitInterfacePragmas, const Supported ), + ( "expose-all-unfoldings", Opt_ExposeAllUnfoldings, const Supported ), ( "do-lambda-eta-expansion", Opt_DoLambdaEtaExpansion, const Supported ), ( "ignore-asserts", Opt_IgnoreAsserts, const Supported ), ( "do-eta-reduction", Opt_DoEtaReduction, const Supported ), @@ -1690,7 +1536,6 @@ fFlags = [ ( "unbox-strict-fields", Opt_UnboxStrictFields, const Supported ), ( "method-sharing", Opt_MethodSharing, const Supported ), ( "dicts-cheap", Opt_DictsCheap, const Supported ), - ( "inline-if-enough-args", Opt_InlineIfEnoughArgs, const Supported ), ( "excess-precision", Opt_ExcessPrecision, const Supported ), ( "eager-blackholing", Opt_EagerBlackHoling, const Supported ), ( "asm-mangling", Opt_DoAsmMangling, const Supported ), @@ -1746,11 +1591,12 @@ fFlags = [ ( "embed-manifest", Opt_EmbedManifest, const Supported ), ( "ext-core", Opt_EmitExternalCore, const Supported ), ( "shared-implib", Opt_SharedImplib, const Supported ), + ( "building-cabal-package", Opt_BuildingCabalPackage, const Supported ), ( "implicit-import-qualified", Opt_ImplicitImportQualified, const Supported ) ] supportedLanguages :: [String] -supportedLanguages = [ name | (name, _, _) <- xFlags ] +supportedLanguages = [ name' | (name, _, _) <- xFlags, name' <- [name, "No" ++ name] ] -- This may contain duplicates languageOptions :: [DynFlag] @@ -1761,6 +1607,7 @@ xFlags :: [(String, DynFlag, Bool -> Deprecated)] xFlags = [ ( "CPP", Opt_Cpp, const Supported ), ( "PostfixOperators", Opt_PostfixOperators, const Supported ), + ( "TupleSections", Opt_TupleSections, const Supported ), ( "PatternGuards", Opt_PatternGuards, const Supported ), ( "UnicodeSyntax", Opt_UnicodeSyntax, const Supported ), ( "MagicHash", Opt_MagicHash, const Supported ), @@ -1776,9 +1623,12 @@ xFlags = [ ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, const Supported ), ( "Rank2Types", Opt_Rank2Types, const Supported ), ( "RankNTypes", Opt_RankNTypes, const Supported ), - ( "ImpredicativeTypes", Opt_ImpredicativeTypes, const Supported ), + ( "ImpredicativeTypes", Opt_ImpredicativeTypes, + const $ Deprecated "impredicative polymorphism will be simplified or removed in GHC 6.14" ), ( "TypeOperators", Opt_TypeOperators, const Supported ), - ( "RecursiveDo", Opt_RecursiveDo, const Supported ), + ( "RecursiveDo", Opt_RecursiveDo, + deprecatedForLanguage "DoRec"), + ( "DoRec", Opt_DoRec, const Supported ), ( "Arrows", Opt_Arrows, const Supported ), ( "PArr", Opt_PArr, const Supported ), ( "TemplateHaskell", Opt_TemplateHaskell, const Supported ), @@ -1798,8 +1648,13 @@ xFlags = [ ( "BangPatterns", Opt_BangPatterns, const Supported ), -- On by default: ( "MonomorphismRestriction", Opt_MonomorphismRestriction, const Supported ), + -- On by default: + ( "NPlusKPatterns", Opt_NPlusKPatterns, const Supported ), -- On by default (which is not strictly H98): ( "MonoPatBinds", Opt_MonoPatBinds, const Supported ), + ( "ExplicitForAll", Opt_ExplicitForAll, const Supported ), + ( "AlternativeLayoutRule", Opt_AlternativeLayoutRule, const Supported ), + ( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, const Supported ), ( "MonoLocalBinds", Opt_MonoLocalBinds, const Supported ), ( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ), ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ), @@ -1831,7 +1686,14 @@ xFlags = [ impliedFlags :: [(DynFlag, DynFlag)] impliedFlags - = [ (Opt_GADTs, Opt_RelaxedPolyRec) -- We want type-sig variables to + = [ (Opt_RankNTypes, Opt_ExplicitForAll) + , (Opt_Rank2Types, Opt_ExplicitForAll) + , (Opt_ScopedTypeVariables, Opt_ExplicitForAll) + , (Opt_LiberalTypeSynonyms, Opt_ExplicitForAll) + , (Opt_ExistentialQuantification, Opt_ExplicitForAll) + , (Opt_PolymorphicComponents, Opt_ExplicitForAll) + + , (Opt_GADTs, Opt_RelaxedPolyRec) -- We want type-sig variables to -- be completely rigid for GADTs , (Opt_TypeFamilies, Opt_RelaxedPolyRec) -- Trac #2944 gives a nice example @@ -1841,6 +1703,12 @@ impliedFlags , (Opt_ScopedTypeVariables, Opt_RelaxedPolyRec) -- Ditto for scoped type variables; see -- Note [Scoped tyvars] in TcBinds , (Opt_ImpredicativeTypes, Opt_RankNTypes) + + -- Record wild-cards implies field disambiguation + -- Otherwise if you write (C {..}) you may well get + -- stuff like " 'a' not in scope ", which is a bit silly + -- if the compiler has just filled in field 'a' of constructor 'C' + , (Opt_RecordWildCards, Opt_DisambiguateRecordFields) ] glasgowExtsFlags :: [DynFlag] @@ -1872,7 +1740,7 @@ glasgowExtsFlags = [ , Opt_LiberalTypeSynonyms , Opt_RankNTypes , Opt_TypeOperators - , Opt_RecursiveDo + , Opt_DoRec , Opt_ParallelListComp , Opt_EmptyDataDecls , Opt_KindSignatures @@ -1905,7 +1773,7 @@ parseDynamicNoPackageFlags dflags args = parseDynamicFlags_ dflags args False parseDynamicFlags_ :: Monad m => DynFlags -> [Located String] -> Bool -> m (DynFlags, [Located String], [Located String]) -parseDynamicFlags_ dflags args pkg_flags = do +parseDynamicFlags_ dflags0 args pkg_flags = do -- XXX Legacy support code -- We used to accept things like -- optdep-f -optdepdepend @@ -1922,10 +1790,23 @@ parseDynamicFlags_ dflags args pkg_flags = do flag_spec | pkg_flags = package_flags ++ dynamic_flags | otherwise = dynamic_flags - let ((leftover, errs, warns), dflags') - = runCmdLine (processArgs flag_spec args') dflags + let ((leftover, errs, warns), dflags1) + = runCmdLine (processArgs flag_spec args') dflags0 when (not (null errs)) $ ghcError $ errorsToGhcException errs - return (dflags', leftover, warns) + + -- Cannot use -fPIC with registerised -fvia-C, because the mangler + -- isn't up to the job. We know that if hscTarget == HscC, then the + -- user has explicitly used -fvia-C, because -fasm is the default, + -- unless there is no NCG on this platform. The latter case is + -- checked when the -fPIC flag is parsed. + -- + let (pic_warns, dflags2) = + if opt_PIC && hscTarget dflags1 == HscC && cGhcUnregisterised == "NO" + then ([L noSrcSpan $ "Warning: -fvia-C is incompatible with -fPIC; ignoring -fvia-C"], + dflags1{ hscTarget = HscAsm }) + else ([], dflags1) + + return (dflags2, leftover, pic_warns ++ warns) type DynP = CmdLineP DynFlags @@ -1950,8 +1831,12 @@ unSetDynFlag f = upd (\dfs -> dopt_unset dfs f) -------------------------- setDumpFlag :: DynFlag -> OptKind DynP -setDumpFlag dump_flag - = NoArg (setDynFlag dump_flag >> when want_recomp forceRecompile) +setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag) + +setDumpFlag' :: DynFlag -> DynP () +setDumpFlag' dump_flag + = do { setDynFlag dump_flag + ; when want_recomp forceRecompile } where -- Certain dumpy-things are really interested in what's going -- on during recompilation checking, so in those cases we @@ -1970,41 +1855,16 @@ forceRecompile = do { dfs <- getCmdLineState force_recomp dfs = isOneShot (ghcMode dfs) setVerboseCore2Core :: DynP () -setVerboseCore2Core = do setDynFlag Opt_D_verbose_core2core - forceRecompile - upd (\s -> s { shouldDumpSimplPhase = const True }) +setVerboseCore2Core = do forceRecompile + setDynFlag Opt_D_verbose_core2core + upd (\dfs -> dfs { shouldDumpSimplPhase = Nothing }) + setDumpSimplPhases :: String -> DynP () setDumpSimplPhases s = do forceRecompile - upd (\s -> s { shouldDumpSimplPhase = spec }) + upd (\dfs -> dfs { shouldDumpSimplPhase = Just 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 + spec = case s of { ('=' : s') -> s'; _ -> s } setVerbosity :: Maybe Int -> DynP () setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 }) @@ -2015,22 +1875,18 @@ addCmdlineHCInclude a = upd (\s -> s{cmdlineHcIncludes = a : cmdlineHcIncludes extraPkgConf_ :: FilePath -> DynP () extraPkgConf_ p = upd (\s -> s{ extraPkgConfs = p : extraPkgConfs s }) -exposePackage, hidePackage, ignorePackage :: String -> DynP () +exposePackage, exposePackageId, hidePackage, ignorePackage :: String -> DynP () exposePackage p = upd (\s -> s{ packageFlags = ExposePackage p : packageFlags s }) +exposePackageId p = + upd (\s -> s{ packageFlags = ExposePackageId p : packageFlags s }) hidePackage p = upd (\s -> s{ packageFlags = HidePackage p : packageFlags s }) ignorePackage p = upd (\s -> s{ packageFlags = IgnorePackage p : packageFlags s }) setPackageName :: String -> DynFlags -> DynFlags -setPackageName p - | Nothing <- unpackPackageId pid - = ghcError (CmdLineError ("cannot parse \'" ++ p ++ "\' as a package identifier")) - | otherwise - = \s -> s{ thisPackage = pid } - where - pid = stringToPackageId p +setPackageName p s = s{ thisPackage = stringToPackageId p } -- If we're linking a binary, then only targets that produce object -- code are allowed (requests for other target types are ignored). @@ -2083,7 +1939,6 @@ setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20 }) `dopt_set` Opt_DictsCheap `dopt_unset` Opt_MethodSharing - `dopt_set` Opt_InlineIfEnoughArgs data DPHBackend = DPHPar | DPHSeq @@ -2206,6 +2061,12 @@ setTmpDir dir dflags = dflags{ tmpDir = normalise dir } -- seem necessary now --SDM 7/2/2008 ----------------------------------------------------------------------------- +-- RTS opts + +setRtsOpts :: String -> DynP () +setRtsOpts arg = upd $ \ d -> d {rtsOpts = Just arg} + +----------------------------------------------------------------------------- -- Hpc stuff setOptHpcDir :: String -> DynP () @@ -2262,10 +2123,20 @@ 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 - sta = opt_Static in - ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "" + ( +#if darwin_TARGET_OS + -- By default, gcc on OS X will generate SSE + -- instructions, which need things 16-byte aligned, + -- but we don't 16-byte align things. Thus drop + -- back to generic i686 compatibility. Trac #2983. + -- + -- Since Snow Leopard (10.6), gcc defaults to x86_64. + ["-march=i686", "-m32"], +#else + [ if opt_Static then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "" ], +#endif [ "-fno-defer-pop", "-fomit-frame-pointer", -- we want -fno-builtin, because when gcc inlines @@ -2335,7 +2206,7 @@ picCCOpts _dflags | otherwise = [] #else - | opt_PIC || not opt_Static + | opt_PIC = ["-fPIC", "-U __PIC__", "-D__PIC__"] | otherwise = [] @@ -2350,21 +2221,25 @@ 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), - ("Debug on", show debugIsOn) +data Printable = String String + | FromDynFlags (DynFlags -> String) + +compilerInfo :: [(String, Printable)] +compilerInfo = [("Project name", String cProjectName), + ("Project version", String cProjectVersion), + ("Booter version", String cBooterVersion), + ("Stage", String cStage), + ("Have interpreter", String cGhcWithInterpreter), + ("Object splitting", String cSplitObjs), + ("Have native code generator", String cGhcWithNativeCodeGen), + ("Have llvm code generator", String cGhcWithLlvmCodeGen), + ("Support SMP", String cGhcWithSMP), + ("Unregisterised", String cGhcUnregisterised), + ("Tables next to code", String cGhcEnableTablesNextToCode), + ("RTS ways", String cGhcRTSWays), + ("Leading underscore", String cLeadingUnderscore), + ("Debug on", String (show debugIsOn)), + ("LibDir", FromDynFlags topDir), + ("Global Package DB", FromDynFlags systemPackageConfig) ]