X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=394965a8508f7256a7134e2357e96a2d9b0a4b46;hp=1e405ea414c5a70f3bcf4e02feaa1a702e6b8d2c;hb=9d0c8f842e35dde3d570580cf62a32779f66a6de;hpb=aedb94f5f220b5e442b23ecc445fd38c8d9b6ba0 diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 1e405ea..394965a 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -1,4 +1,3 @@ - -- | -- Dynamic flags -- @@ -31,10 +30,10 @@ module DynFlags ( dopt_set, dopt_unset, -- DynFlags -> DynFlag -> DynFlags getOpts, -- DynFlags -> (DynFlags -> [a]) -> [a] getVerbFlag, - getMainFun, updOptLevel, setTmpDir, setPackageName, + doingTickyProfiling, -- ** Parsing DynFlags parseDynamicFlags, @@ -63,12 +62,13 @@ module DynFlags ( #include "HsVersions.h" +#ifndef OMIT_NATIVE_CODEGEN +import Platform +#endif import Module import PackageConfig -import PrelNames ( mAIN, main_RDR_Unqual ) -import RdrName ( RdrName, mkRdrUnqual ) -import OccName ( mkVarOccFS ) -#ifdef i386_TARGET_ARCH +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, @@ -84,10 +84,11 @@ import Util import Maybes ( orElse ) import SrcLoc import FastString +import FiniteMap import Outputable import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) -import Data.IORef ( readIORef ) +import Data.IORef import Control.Monad ( when ) import Data.Char @@ -115,6 +116,7 @@ data DynFlag | Opt_D_dump_asm_regalloc_stages | Opt_D_dump_asm_conflicts | Opt_D_dump_asm_stats + | Opt_D_dump_asm_expanded | Opt_D_dump_cpranal | Opt_D_dump_deriv | Opt_D_dump_ds @@ -188,6 +190,10 @@ data DynFlag | Opt_WarnTabs | Opt_WarnUnrecognisedPragmas | Opt_WarnDodgyForeignImports + | Opt_WarnLazyUnliftedBindings + | Opt_WarnUnusedDoBind + | Opt_WarnWrongDoBind + -- language opts | Opt_OverlappingInstances @@ -195,9 +201,11 @@ data DynFlag | Opt_IncoherentInstances | Opt_MonomorphismRestriction | Opt_MonoPatBinds + | Opt_MonoLocalBinds | Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting | Opt_ForeignFunctionInterface | Opt_UnliftedFFITypes + | Opt_GHCForeignImportPrim | Opt_PArr -- Syntactic support for parallel arrays | Opt_Arrows -- Arrow-notation syntax | Opt_TemplateHaskell @@ -216,8 +224,13 @@ data DynFlag | Opt_ViewPatterns | Opt_GADTs | Opt_RelaxedPolyRec + | Opt_StandaloneDeriving | Opt_DeriveDataTypeable + | Opt_DeriveFunctor + | Opt_DeriveTraversable + | Opt_DeriveFoldable + | Opt_TypeSynonymInstances | Opt_FlexibleContexts | Opt_FlexibleInstances @@ -336,6 +349,9 @@ data DynFlags = DynFlags { specConstrCount :: Maybe Int, -- ^ Max number of specialisations for any one function liberateCaseThreshold :: Maybe Int, -- ^ Threshold for LiberateCase +#ifndef OMIT_NATIVE_CODEGEN + targetPlatform :: Platform, -- ^ The platform we're compiling for. Used by the NCG. +#endif stolen_x86_regs :: Int, cmdlineHcIncludes :: [String], -- ^ @\-\#includes@ importPaths :: [FilePath], @@ -433,6 +449,12 @@ data DynFlags = DynFlags { pkgDatabase :: Maybe (UniqFM PackageConfig), pkgState :: PackageState, + -- Temporary files + -- These have to be IORefs, because the defaultCleanupHandler needs to + -- know what to clean when an exception happens + filesToClean :: IORef [FilePath], + dirsToClean :: IORef (FiniteMap FilePath FilePath), + -- hsc dynamic flags flags :: [DynFlag], @@ -510,6 +532,11 @@ isNoLink :: GhcLink -> Bool isNoLink NoLink = True 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 + data PackageFlag = ExposePackage String | HidePackage String @@ -539,10 +566,14 @@ initDynFlags dflags = do 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 + rtsBuildTag = rts_build_tag, + filesToClean = refFilesToClean, + dirsToClean = refDirsToClean } -- | The normal 'DynFlags'. Note that they is not suitable for use in this form @@ -566,6 +597,9 @@ defaultDynFlags = specConstrThreshold = Just 200, specConstrCount = Just 3, liberateCaseThreshold = Just 200, +#ifndef OMIT_NATIVE_CODEGEN + targetPlatform = defaultTargetPlatform, +#endif stolen_x86_regs = 4, cmdlineHcIncludes = [], importPaths = ["."], @@ -587,7 +621,7 @@ defaultDynFlags = outputFile = Nothing, outputHi = Nothing, - dynLibLoader = Deployable, + dynLibLoader = SystemDependent, dumpPrefix = Nothing, dumpPrefixForce = Nothing, includePaths = [], @@ -641,6 +675,8 @@ defaultDynFlags = depExcludeMods = [], depSuffixes = [], -- end of ghc -M values + filesToClean = panic "defaultDynFlags: No filesToClean", + dirsToClean = panic "defaultDynFlags: No dirsToClean", haddockOptions = Nothing, flags = [ Opt_AutoLinkPackages, @@ -874,7 +910,9 @@ standardWarnings Opt_WarnMissingFields, Opt_WarnMissingMethods, Opt_WarnDuplicateExports, - Opt_WarnDodgyForeignImports + Opt_WarnLazyUnliftedBindings, + Opt_WarnDodgyForeignImports, + Opt_WarnWrongDoBind ] minusWOpts :: [DynFlag] @@ -894,7 +932,8 @@ minusWallOpts Opt_WarnNameShadowing, Opt_WarnMissingSigs, Opt_WarnHiShadows, - Opt_WarnOrphans + Opt_WarnOrphans, + Opt_WarnUnusedDoBind ] -- minuswRemovesOpts should be every warning option @@ -971,8 +1010,8 @@ pprFloatOutSwitches sw = pp_not (floatOutLambdas sw) <+> text "lambdas" <> comma pp_not False = text "not" -- | Switches that specify the minimum amount of floating out -gentleFloatOutSwitches :: FloatOutSwitches -gentleFloatOutSwitches = FloatOutSwitches False False +-- gentleFloatOutSwitches :: FloatOutSwitches +-- gentleFloatOutSwitches = FloatOutSwitches False False -- | Switches that do not specify floating out of lambdas, just of constants constantsOnlyFloatOutSwitches :: FloatOutSwitches @@ -1074,7 +1113,14 @@ getCoreToDo dflags -- so that overloaded functions have all their dictionary lambdas manifest CoreDoSpecialising, - runWhen full_laziness (CoreDoFloatOutwards gentleFloatOutSwitches), + 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, @@ -1324,6 +1370,8 @@ dynamic_flags = [ Supported , Flag "ddump-asm-stats" (setDumpFlag Opt_D_dump_asm_stats) Supported + , Flag "ddump-asm-expanded" (setDumpFlag Opt_D_dump_asm_expanded) + Supported , Flag "ddump-cpranal" (setDumpFlag Opt_D_dump_cpranal) Supported , Flag "ddump-deriv" (setDumpFlag Opt_D_dump_deriv) @@ -1618,6 +1666,10 @@ fFlags = [ ( "warn-orphans", Opt_WarnOrphans, const Supported ), ( "warn-tabs", Opt_WarnTabs, const Supported ), ( "warn-unrecognised-pragmas", Opt_WarnUnrecognisedPragmas, const Supported ), + ( "warn-lazy-unlifted-bindings", Opt_WarnLazyUnliftedBindings, + 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 ), ( "print-explicit-foralls", Opt_PrintExplicitForalls, const Supported ), ( "strictness", Opt_Strictness, const Supported ), ( "static-argument-transformation", Opt_StaticArgumentTransformation, const Supported ), @@ -1714,6 +1766,7 @@ xFlags = [ ( "TransformListComp", Opt_TransformListComp, const Supported ), ( "ForeignFunctionInterface", Opt_ForeignFunctionInterface, const Supported ), ( "UnliftedFFITypes", Opt_UnliftedFFITypes, const Supported ), + ( "GHCForeignImportPrim", Opt_GHCForeignImportPrim, const Supported ), ( "LiberalTypeSynonyms", Opt_LiberalTypeSynonyms, const Supported ), ( "Rank2Types", Opt_Rank2Types, const Supported ), ( "RankNTypes", Opt_RankNTypes, const Supported ), @@ -1741,6 +1794,7 @@ xFlags = [ ( "MonomorphismRestriction", Opt_MonomorphismRestriction, const Supported ), -- On by default (which is not strictly H98): ( "MonoPatBinds", Opt_MonoPatBinds, const Supported ), + ( "MonoLocalBinds", Opt_MonoLocalBinds, const Supported ), ( "RelaxedPolyRec", Opt_RelaxedPolyRec, const Supported ), ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, const Supported ), ( "ImplicitParams", Opt_ImplicitParams, const Supported ), @@ -1752,6 +1806,9 @@ xFlags = [ ( "UnboxedTuples", Opt_UnboxedTuples, const Supported ), ( "StandaloneDeriving", Opt_StandaloneDeriving, const Supported ), ( "DeriveDataTypeable", Opt_DeriveDataTypeable, const Supported ), + ( "DeriveFunctor", Opt_DeriveFunctor, const Supported ), + ( "DeriveTraversable", Opt_DeriveTraversable, const Supported ), + ( "DeriveFoldable", Opt_DeriveFoldable, const Supported ), ( "TypeSynonymInstances", Opt_TypeSynonymInstances, const Supported ), ( "FlexibleContexts", Opt_FlexibleContexts, const Supported ), ( "FlexibleInstances", Opt_FlexibleInstances, const Supported ), @@ -1771,8 +1828,13 @@ impliedFlags = [ (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 + , (Opt_TypeFamilies, Opt_KindSignatures) -- Type families use kind signatures + -- all over the place + , (Opt_ScopedTypeVariables, Opt_RelaxedPolyRec) -- Ditto for scoped type variables; see -- Note [Scoped tyvars] in TcBinds + , (Opt_ImpredicativeTypes, Opt_RankNTypes) ] glasgowExtsFlags :: [DynFlag] @@ -1787,6 +1849,9 @@ glasgowExtsFlags = [ , Opt_TypeSynonymInstances , Opt_StandaloneDeriving , Opt_DeriveDataTypeable + , Opt_DeriveFunctor + , Opt_DeriveFoldable + , Opt_DeriveTraversable , Opt_FlexibleContexts , Opt_FlexibleInstances , Opt_ConstrainedClassMethods @@ -1800,7 +1865,6 @@ glasgowExtsFlags = [ , Opt_PatternGuards , Opt_LiberalTypeSynonyms , Opt_RankNTypes - , Opt_ImpredicativeTypes , Opt_TypeOperators , Opt_RecursiveDo , Opt_ParallelListComp @@ -1999,12 +2063,15 @@ setOptLevel n dflags -- sometimes -- -fdicts-cheap always inline dictionaries -- -fmax-simplifier-iterations20 this is necessary sometimes +-- -fsimplifier-phases=3 we use an additional simplifier phase +-- for fusion -- -fno-spec-constr-threshold run SpecConstr even for big loops -- -fno-spec-constr-count SpecConstr as much as possible -- -finline-enough-args hack to prevent excessive inlining -- setDPHOpt :: DynFlags -> DynFlags setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20 + , simplPhases = 3 , specConstrThreshold = Nothing , specConstrCount = Nothing }) @@ -2048,13 +2115,6 @@ setMainIs arg where (main_mod, main_fn) = splitLongestPrefix arg (== '.') --- | Get the unqualified name of the function to use as the \"main\" for the main module. --- Either returns the default name or the one configured on the command line with -main-is -getMainFun :: DynFlags -> RdrName -getMainFun dflags = case (mainFunIs dflags) of - Just fn -> mkRdrUnqual (mkVarOccFS (mkFastString fn)) - Nothing -> main_RDR_Unqual - ----------------------------------------------------------------------------- -- Paths & Libraries @@ -2213,7 +2273,13 @@ machdepCCOpts _dflags = ( [], ["-fomit-frame-pointer", "-G0"] ) #elif x86_64_TARGET_ARCH - = ( [], ["-fomit-frame-pointer", + = ( +#if darwin_TARGET_OS + ["-m64"], +#else + [], +#endif + ["-fomit-frame-pointer", "-fno-asynchronous-unwind-tables", -- the unwind tables are unnecessary for HC code, -- and get in the way of -split-objs. Another option @@ -2263,7 +2329,7 @@ picCCOpts _dflags | otherwise = [] #else - | opt_PIC + | opt_PIC || not opt_Static = ["-fPIC", "-U __PIC__", "-D__PIC__"] | otherwise = []