X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=68187938c0caa3131ae8b0e530f924d40e8a2016;hp=b067782242ba004a8227683fd188efb866315a01;hb=e8fa04cf0d656c4a2ff737278b8cea9fce3b5a2b;hpb=5cd20c4026ffecda7822979b7de87e6a6a6fef20 diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index b067782..6818793 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -14,14 +14,19 @@ -- flags. Dynamic flags can also be set at the prompt in GHCi. module DynFlags ( -- * Dynamic flags and associated configuration types - DOpt(..), DynFlag(..), ExtensionFlag(..), glasgowExtsFlags, flattenExtensionFlags, ensureFlattenedExtensionFlags, - lopt_set_flattened, - lopt_unset_flattened, + dopt, + dopt_set, + dopt_unset, + xopt, + xopt_set, + xopt_unset, + xopt_set_flattened, + xopt_unset_flattened, DynFlags(..), RtsOptsEnabled(..), HscTarget(..), isObjectTarget, defaultObjectTarget, @@ -88,7 +93,6 @@ import Util import Maybes ( orElse ) import SrcLoc import FastString -import FiniteMap import Outputable import Foreign.C ( CInt ) import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) @@ -99,6 +103,8 @@ import Control.Monad ( when ) import Data.Char import Data.List +import Data.Map (Map) +import qualified Data.Map as Map import System.FilePath import System.IO ( stderr, hPutChar ) @@ -183,6 +189,7 @@ data DynFlag | Opt_WarnMissingImportList | Opt_WarnMissingMethods | Opt_WarnMissingSigs + | Opt_WarnMissingLocalSigs | Opt_WarnNameShadowing | Opt_WarnOverlappingPatterns | Opt_WarnSimplePatterns @@ -293,6 +300,7 @@ data ExtensionFlag | Opt_MonomorphismRestriction | Opt_MonoPatBinds | Opt_MonoLocalBinds + | Opt_RelaxedPolyRec -- Deprecated | Opt_ExtendedDefaultRules -- Use GHC's extended rules for defaulting | Opt_ForeignFunctionInterface | Opt_UnliftedFFITypes @@ -314,7 +322,6 @@ data ExtensionFlag | Opt_RecordPuns | Opt_ViewPatterns | Opt_GADTs - | Opt_RelaxedPolyRec | Opt_NPlusKPatterns | Opt_DoAndIfThenElse @@ -488,7 +495,7 @@ data DynFlags = DynFlags { -- 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), + dirsToClean :: IORef (Map FilePath FilePath), -- hsc dynamic flags flags :: [DynFlag], @@ -601,7 +608,6 @@ defaultObjectTarget data DynLibLoader = Deployable - | Wrapped (Maybe String) | SystemDependent deriving Eq @@ -613,7 +619,7 @@ initDynFlags dflags = do -- someday these will be dynamic flags ways <- readIORef v_Ways refFilesToClean <- newIORef [] - refDirsToClean <- newIORef emptyFM + refDirsToClean <- newIORef Map.empty return dflags{ ways = ways, buildTag = mkBuildTag (filter (not . wayRTSOnly) ways), @@ -731,24 +737,7 @@ defaultDynFlags = filesToClean = panic "defaultDynFlags: No filesToClean", dirsToClean = panic "defaultDynFlags: No dirsToClean", haddockOptions = Nothing, - flags = [ - Opt_AutoLinkPackages, - Opt_ReadUserPackageConf, - - Opt_MethodSharing, - - Opt_DoAsmMangling, - - Opt_SharedImplib, - - Opt_GenManifest, - Opt_EmbedManifest, - Opt_PrintBindContents - ] - ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] - -- The default -O0 options - ++ standardWarnings, - + flags = defaultFlags, language = Nothing, extensionFlags = Left [], @@ -813,6 +802,8 @@ languageExtensions Nothing = Opt_MonoPatBinds -- Experimentally, I'm making this non-standard -- behaviour the default, to see if anyone notices -- SLPJ July 06 + -- In due course I'd like Opt_MonoLocalBinds to be on by default + -- SLPJ September 2010 : languageExtensions (Just Haskell2010) languageExtensions (Just Haskell98) = [Opt_ImplicitPrelude, @@ -829,64 +820,47 @@ languageExtensions (Just Haskell2010) Opt_DoAndIfThenElse, Opt_RelaxedPolyRec] --- The DOpt class is a temporary workaround, to avoid having to do --- a mass-renaming dopt->lopt at the moment -class DOpt a where - dopt :: a -> DynFlags -> Bool - dopt_set :: DynFlags -> a -> DynFlags - dopt_unset :: DynFlags -> a -> DynFlags - -instance DOpt DynFlag where - dopt = dopt' - dopt_set = dopt_set' - dopt_unset = dopt_unset' - -instance DOpt ExtensionFlag where - dopt = lopt - dopt_set = lopt_set - dopt_unset = lopt_unset - -- | Test whether a 'DynFlag' is set -dopt' :: DynFlag -> DynFlags -> Bool -dopt' f dflags = f `elem` (flags dflags) +dopt :: DynFlag -> DynFlags -> Bool +dopt f dflags = f `elem` (flags dflags) -- | Set a 'DynFlag' -dopt_set' :: DynFlags -> DynFlag -> DynFlags -dopt_set' dfs f = dfs{ flags = f : flags dfs } +dopt_set :: DynFlags -> DynFlag -> DynFlags +dopt_set dfs f = dfs{ flags = f : flags dfs } -- | Unset a 'DynFlag' -dopt_unset' :: DynFlags -> DynFlag -> DynFlags -dopt_unset' dfs f = dfs{ flags = filter (/= f) (flags dfs) } +dopt_unset :: DynFlags -> DynFlag -> DynFlags +dopt_unset dfs f = dfs{ flags = filter (/= f) (flags dfs) } -- | Test whether a 'ExtensionFlag' is set -lopt :: ExtensionFlag -> DynFlags -> Bool -lopt f dflags = case extensionFlags dflags of +xopt :: ExtensionFlag -> DynFlags -> Bool +xopt f dflags = case extensionFlags dflags of Left _ -> panic ("Testing for extension flag " ++ show f ++ " before flattening") Right flags -> f `elem` flags -- | Set a 'ExtensionFlag' -lopt_set :: DynFlags -> ExtensionFlag -> DynFlags -lopt_set dfs f = case extensionFlags dfs of +xopt_set :: DynFlags -> ExtensionFlag -> DynFlags +xopt_set dfs f = case extensionFlags dfs of Left onoffs -> dfs { extensionFlags = Left (On f : onoffs) } Right _ -> panic ("Setting extension flag " ++ show f ++ " after flattening") -- | Set a 'ExtensionFlag' -lopt_set_flattened :: DynFlags -> ExtensionFlag -> DynFlags -lopt_set_flattened dfs f = case extensionFlags dfs of +xopt_set_flattened :: DynFlags -> ExtensionFlag -> DynFlags +xopt_set_flattened dfs f = case extensionFlags dfs of Left _ -> panic ("Setting extension flag " ++ show f ++ " before flattening, but expected flattened") Right flags -> dfs { extensionFlags = Right (f : delete f flags) } -- | Unset a 'ExtensionFlag' -lopt_unset :: DynFlags -> ExtensionFlag -> DynFlags -lopt_unset dfs f = case extensionFlags dfs of +xopt_unset :: DynFlags -> ExtensionFlag -> DynFlags +xopt_unset dfs f = case extensionFlags dfs of Left onoffs -> dfs { extensionFlags = Left (Off f : onoffs) } Right _ -> panic ("Unsetting extension flag " ++ show f ++ " after flattening") -- | Unset a 'ExtensionFlag' -lopt_unset_flattened :: DynFlags -> ExtensionFlag -> DynFlags -lopt_unset_flattened dfs f = case extensionFlags dfs of +xopt_unset_flattened :: DynFlags -> ExtensionFlag -> DynFlags +xopt_unset_flattened dfs f = case extensionFlags dfs of Left _ -> panic ("Unsetting extension flag " ++ show f ++ " before flattening, but expected flattened") Right flags -> @@ -933,9 +907,6 @@ 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) } _ -> ghcError (CmdLineError ("Unknown dynlib loader: " ++ f)) setDumpPrefixForce f d = d { dumpPrefixForce = f} @@ -1007,94 +978,6 @@ updOptLevel n dfs extra_dopts = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ] remove_dopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ] -optLevelFlags :: [([Int], DynFlag)] -optLevelFlags - = [ ([0], Opt_IgnoreInterfacePragmas) - , ([0], Opt_OmitInterfacePragmas) - - , ([1,2], Opt_IgnoreAsserts) - , ([1,2], Opt_EnableRewriteRules) -- Off for -O0; see Note [Scoping for Builtin rules] - -- in PrelRules - , ([1,2], Opt_DoEtaReduction) - , ([1,2], Opt_CaseMerge) - , ([1,2], Opt_Strictness) - , ([1,2], Opt_CSE) - , ([1,2], Opt_FullLaziness) - , ([1,2], Opt_Specialise) - , ([1,2], Opt_FloatIn) - - , ([2], Opt_LiberateCase) - , ([2], Opt_SpecConstr) - --- , ([2], Opt_StaticArgumentTransformation) --- Max writes: I think it's probably best not to enable SAT with -O2 for the --- 6.10 release. The version of SAT in HEAD at the moment doesn't incorporate --- several improvements to the heuristics, and I'm concerned that without --- those changes SAT will interfere with some attempts to write "high --- performance Haskell", as we saw in some posts on Haskell-Cafe earlier --- this year. In particular, the version in HEAD lacks the tail call --- criterion, so many things that look like reasonable loops will be --- turned into functions with extra (unneccesary) thunk creation. - - , ([0,1,2], Opt_DoLambdaEtaExpansion) - -- This one is important for a tiresome reason: - -- we want to make sure that the bindings for data - -- constructors are eta-expanded. This is probably - -- a good thing anyway, but it seems fragile. - ] - --- ----------------------------------------------------------------------------- --- Standard sets of warning options - -standardWarnings :: [DynFlag] -standardWarnings - = [ Opt_WarnWarningsDeprecations, - Opt_WarnDeprecatedFlags, - Opt_WarnUnrecognisedPragmas, - Opt_WarnOverlappingPatterns, - Opt_WarnMissingFields, - Opt_WarnMissingMethods, - Opt_WarnDuplicateExports, - Opt_WarnLazyUnliftedBindings, - Opt_WarnDodgyForeignImports, - Opt_WarnWrongDoBind, - Opt_WarnAlternativeLayoutRuleTransitional - ] - -minusWOpts :: [DynFlag] -minusWOpts - = standardWarnings ++ - [ Opt_WarnUnusedBinds, - Opt_WarnUnusedMatches, - Opt_WarnUnusedImports, - Opt_WarnIncompletePatterns, - Opt_WarnDodgyExports, - Opt_WarnDodgyImports - ] - -minusWallOpts :: [DynFlag] -minusWallOpts - = minusWOpts ++ - [ Opt_WarnTypeDefaults, - Opt_WarnNameShadowing, - Opt_WarnMissingSigs, - Opt_WarnHiShadows, - Opt_WarnOrphans, - Opt_WarnUnusedDoBind - ] - --- minuswRemovesOpts should be every warning option -minuswRemovesOpts :: [DynFlag] -minuswRemovesOpts - = minusWallOpts ++ - [Opt_WarnImplicitPrelude, - Opt_WarnIncompletePatternsRecUpd, - Opt_WarnSimplePatterns, - Opt_WarnMonomorphism, - Opt_WarnUnrecognisedPragmas, - Opt_WarnTabs - ] - -- ----------------------------------------------------------------------------- -- StgToDo: abstraction of stg-to-stg passes to run. @@ -1504,7 +1387,7 @@ type FlagSpec flag , Bool -> DynP ()) -- Extra action to run when the flag is found -- Typically, emit a warning or error -- True <=> we are turning the flag on - -- False <=> we are turning the flag on + -- False <=> we are turning the flag off mkFlag :: Bool -- ^ True <=> it should be turned on @@ -1546,6 +1429,7 @@ fFlags = [ ( "warn-missing-import-lists", Opt_WarnMissingImportList, nop ), ( "warn-missing-methods", Opt_WarnMissingMethods, nop ), ( "warn-missing-signatures", Opt_WarnMissingSigs, nop ), + ( "warn-missing-local-sigs", Opt_WarnMissingLocalSigs, nop ), ( "warn-name-shadowing", Opt_WarnNameShadowing, nop ), ( "warn-overlapping-patterns", Opt_WarnOverlappingPatterns, nop ), ( "warn-simple-patterns", Opt_WarnSimplePatterns, nop ), @@ -1560,8 +1444,7 @@ fFlags = [ ( "warn-orphans", Opt_WarnOrphans, nop ), ( "warn-tabs", Opt_WarnTabs, nop ), ( "warn-unrecognised-pragmas", Opt_WarnUnrecognisedPragmas, nop ), - ( "warn-lazy-unlifted-bindings", Opt_WarnLazyUnliftedBindings, - \_ -> deprecate "lazy unlifted bindings will be an error in GHC 6.14, and this flag will no longer exist"), + ( "warn-lazy-unlifted-bindings", Opt_WarnLazyUnliftedBindings, nop), ( "warn-unused-do-bind", Opt_WarnUnusedDoBind, nop ), ( "warn-wrong-do-bind", Opt_WarnWrongDoBind, nop ), ( "warn-alternative-layout-rule-transitional", Opt_WarnAlternativeLayoutRuleTransitional, nop ), @@ -1716,7 +1599,10 @@ xFlags = [ ( "AlternativeLayoutRuleTransitional",Opt_AlternativeLayoutRuleTransitional, nop ), ( "DatatypeContexts", Opt_DatatypeContexts, nop ), ( "MonoLocalBinds", Opt_MonoLocalBinds, nop ), - ( "RelaxedPolyRec", Opt_RelaxedPolyRec, nop ), + ( "RelaxedPolyRec", Opt_RelaxedPolyRec, + \ turn_on -> if not turn_on + then deprecate "You can't turn off RelaxedPolyRec any more" + else return () ), ( "ExtendedDefaultRules", Opt_ExtendedDefaultRules, nop ), ( "ImplicitParams", Opt_ImplicitParams, nop ), ( "ScopedTypeVariables", Opt_ScopedTypeVariables, nop ), @@ -1745,6 +1631,27 @@ xFlags = [ \_ -> deprecate "The new qualified operator syntax was rejected by Haskell'" ) ] +defaultFlags :: [DynFlag] +defaultFlags + = [ Opt_AutoLinkPackages, + Opt_ReadUserPackageConf, + + Opt_MethodSharing, + + Opt_DoAsmMangling, + + Opt_SharedImplib, + + Opt_GenManifest, + Opt_EmbedManifest, + Opt_PrintBindContents + ] + + ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] + -- The default -O0 options + + ++ standardWarnings + impliedFlags :: [(ExtensionFlag, ExtensionFlag)] impliedFlags = [ (Opt_RankNTypes, Opt_ExplicitForAll) @@ -1754,15 +1661,13 @@ impliedFlags , (Opt_ExistentialQuantification, Opt_ExplicitForAll) , (Opt_PolymorphicComponents, Opt_ExplicitForAll) - , (Opt_GADTs, Opt_RelaxedPolyRec) -- We want type-sig variables to - -- be completely rigid for GADTs + , (Opt_GADTs, Opt_MonoLocalBinds) + , (Opt_TypeFamilies, Opt_MonoLocalBinds) + , (Opt_FunctionalDependencies, Opt_MonoLocalBinds) - , (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) -- Record wild-cards implies field disambiguation @@ -1772,6 +1677,95 @@ impliedFlags , (Opt_RecordWildCards, Opt_DisambiguateRecordFields) ] +optLevelFlags :: [([Int], DynFlag)] +optLevelFlags + = [ ([0], Opt_IgnoreInterfacePragmas) + , ([0], Opt_OmitInterfacePragmas) + + , ([1,2], Opt_IgnoreAsserts) + , ([1,2], Opt_EnableRewriteRules) -- Off for -O0; see Note [Scoping for Builtin rules] + -- in PrelRules + , ([1,2], Opt_DoEtaReduction) + , ([1,2], Opt_CaseMerge) + , ([1,2], Opt_Strictness) + , ([1,2], Opt_CSE) + , ([1,2], Opt_FullLaziness) + , ([1,2], Opt_Specialise) + , ([1,2], Opt_FloatIn) + + , ([2], Opt_LiberateCase) + , ([2], Opt_SpecConstr) + , ([2], Opt_RegsGraph) + +-- , ([2], Opt_StaticArgumentTransformation) +-- Max writes: I think it's probably best not to enable SAT with -O2 for the +-- 6.10 release. The version of SAT in HEAD at the moment doesn't incorporate +-- several improvements to the heuristics, and I'm concerned that without +-- those changes SAT will interfere with some attempts to write "high +-- performance Haskell", as we saw in some posts on Haskell-Cafe earlier +-- this year. In particular, the version in HEAD lacks the tail call +-- criterion, so many things that look like reasonable loops will be +-- turned into functions with extra (unneccesary) thunk creation. + + , ([0,1,2], Opt_DoLambdaEtaExpansion) + -- This one is important for a tiresome reason: + -- we want to make sure that the bindings for data + -- constructors are eta-expanded. This is probably + -- a good thing anyway, but it seems fragile. + ] + +-- ----------------------------------------------------------------------------- +-- Standard sets of warning options + +standardWarnings :: [DynFlag] +standardWarnings + = [ Opt_WarnWarningsDeprecations, + Opt_WarnDeprecatedFlags, + Opt_WarnUnrecognisedPragmas, + Opt_WarnOverlappingPatterns, + Opt_WarnMissingFields, + Opt_WarnMissingMethods, + Opt_WarnDuplicateExports, + Opt_WarnLazyUnliftedBindings, + Opt_WarnDodgyForeignImports, + Opt_WarnWrongDoBind, + Opt_WarnAlternativeLayoutRuleTransitional + ] + +minusWOpts :: [DynFlag] +minusWOpts + = standardWarnings ++ + [ Opt_WarnUnusedBinds, + Opt_WarnUnusedMatches, + Opt_WarnUnusedImports, + Opt_WarnIncompletePatterns, + Opt_WarnDodgyExports, + Opt_WarnDodgyImports + ] + +minusWallOpts :: [DynFlag] +minusWallOpts + = minusWOpts ++ + [ Opt_WarnTypeDefaults, + Opt_WarnNameShadowing, + Opt_WarnMissingSigs, + Opt_WarnHiShadows, + Opt_WarnOrphans, + Opt_WarnUnusedDoBind + ] + +-- minuswRemovesOpts should be every warning option +minuswRemovesOpts :: [DynFlag] +minuswRemovesOpts + = minusWallOpts ++ + [Opt_WarnImplicitPrelude, + Opt_WarnIncompletePatternsRecUpd, + Opt_WarnSimplePatterns, + Opt_WarnMonomorphism, + Opt_WarnUnrecognisedPragmas, + Opt_WarnTabs + ] + enableGlasgowExts :: DynP () enableGlasgowExts = do setDynFlag Opt_PrintExplicitForalls mapM_ setExtensionFlag glasgowExtsFlags @@ -1879,7 +1873,7 @@ setLanguage l = upd (\dfs -> dfs { language = Just l }) -------------------------- setExtensionFlag, unSetExtensionFlag :: ExtensionFlag -> DynP () -setExtensionFlag f = do { upd (\dfs -> lopt_set dfs f) +setExtensionFlag f = do { upd (\dfs -> xopt_set dfs f) ; mapM_ setExtensionFlag deps } where deps = [ d | (f', d) <- impliedFlags, f' == f ] @@ -1889,7 +1883,7 @@ setExtensionFlag f = do { upd (\dfs -> lopt_set dfs f) -- When you un-set f, however, we don't un-set the things it implies -- (except for -fno-glasgow-exts, which is treated specially) -unSetExtensionFlag f = upd (\dfs -> lopt_unset dfs f) +unSetExtensionFlag f = upd (\dfs -> xopt_unset dfs f) -------------------------- setDumpFlag' :: DynFlag -> DynP ()