X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=91c7f4369f9d5f7cab4bce7db24b4f3a34b0e2f3;hb=5e04ae341a945ef430e9d941b34722b8de1f6aae;hp=5d8922cd069cc14a1ba89b546389f5f83ee13a08;hpb=03d8585e0940e28e024548654fe3505685aca94f;p=ghc-hetmet.git diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 5d8922c..91c7f43 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -29,6 +29,7 @@ module DynFlags ( GhcLink(..), isNoLink, PackageFlag(..), Option(..), + fFlags, xFlags, -- Configuration of the core-to-core and stg-to-stg phases CoreToDo(..), @@ -125,6 +126,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 @@ -223,12 +225,14 @@ data DynFlag | 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 @@ -243,7 +247,6 @@ data DynFlag | Opt_OmitInterfacePragmas | Opt_DoLambdaEtaExpansion | Opt_IgnoreAsserts - | Opt_IgnoreBreakpoints | Opt_DoEtaReduction | Opt_CaseMerge | Opt_UnboxStrictFields @@ -272,6 +275,7 @@ data DynFlag | Opt_BreakOnException | Opt_BreakOnError | Opt_PrintEvldWithShow + | Opt_PrintBindContents | Opt_GenManifest | Opt_EmbedManifest | Opt_RunCPSZ @@ -299,7 +303,8 @@ data DynFlags = DynFlags { maxSimplIterations :: Int, -- max simplifier iterations ruleCheck :: Maybe String, - specThreshold :: Int, -- Threshold for function specialisation + specConstrThreshold :: Maybe Int, -- Threshold for SpecConstr + liberateCaseThreshold :: Maybe Int, -- Threshold for LiberateCase stolen_x86_regs :: Int, cmdlineHcIncludes :: [String], -- -#includes @@ -432,7 +437,7 @@ 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 @@ -476,7 +481,8 @@ defaultDynFlags = optLevel = 0, maxSimplIterations = 4, ruleCheck = Nothing, - specThreshold = 200, + specConstrThreshold = Just 200, + liberateCaseThreshold = Just 200, stolen_x86_regs = 4, cmdlineHcIncludes = [], importPaths = ["."], @@ -523,27 +529,26 @@ defaultDynFlags = pkgDatabase = Nothing, pkgState = panic "no package state yet: call GHC.setSessionDynFlags", haddockOptions = Nothing, - flags = [ - Opt_ReadUserPackageConf, - - Opt_MonoPatBinds, -- Experimentally, I'm making this non-standard - -- behaviour the default, to see if anyone notices - -- SLPJ July 06 + 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_DoAsmMangling, - Opt_DoAsmMangling, - Opt_GenManifest, Opt_EmbedManifest, + Opt_PrintBindContents + ] + ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] + -- The default -O0 options + ++ standardWarnings, - -- on by default: - Opt_PrintBindResult ] - ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] - -- The default -O0 options - ++ standardWarnings, - log_action = \severity srcSpan style msg -> case severity of SevInfo -> hPutStrLn stderr (show (msg style)) @@ -847,7 +852,7 @@ getCoreToDo dflags -- Phase 0: allow all Ids to be inlined now -- This gets foldr inlined before strictness analysis - MaxSimplifierIterations 3 + MaxSimplifierIterations (max max_iter 3) -- At least 3 iterations because otherwise we land up with -- huge dead expressions because of an infelicity in the -- simpifier. @@ -901,10 +906,15 @@ getCoreToDo dflags runWhen spec_constr CoreDoSpecConstr, + case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing }, + -- Final clean-up simplification: CoreDoSimplify (SimplPhase 0) [ MaxSimplifierIterations max_iter - ] + ], + + case rule_check of { Just pat -> CoreDoRuleCheck 0 pat; Nothing -> CoreDoNothing } + ] -- ----------------------------------------------------------------------------- @@ -937,10 +947,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 = [ @@ -1071,6 +1084,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", setDumpFlag Opt_D_dump_simpl_phases) , ( "ddump-spec", setDumpFlag Opt_D_dump_spec) , ( "ddump-prep", setDumpFlag Opt_D_dump_prep) , ( "ddump-stg", setDumpFlag Opt_D_dump_stg) @@ -1130,11 +1144,16 @@ dynamic_flags = [ , ( "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 }))) + , ( "fspec-constr-threshold", IntSuffix (\n -> + upd (\dfs -> dfs{ specConstrThreshold = Just n }))) + , ( "fno-spec-constr-threshold", NoArg ( + upd (\dfs -> dfs{ specConstrThreshold = 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 }))) + , ( "frule-check", SepArg (\s -> upd (\dfs -> dfs{ ruleCheck = Just s }))) , ( "fcontext-stack" , IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n }) ------ Compiler flags ----------------------------------------------- @@ -1196,7 +1215,6 @@ fFlags = [ ( "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 ), @@ -1210,6 +1228,7 @@ fFlags = [ ( "break-on-exception", Opt_BreakOnException ), ( "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 ), @@ -1267,11 +1286,13 @@ xFlags = [ ( "PatternSignatures", Opt_PatternSignatures ), ( "EmptyDataDecls", Opt_EmptyDataDecls ), ( "ParallelListComp", Opt_ParallelListComp ), + ( "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 ), @@ -1320,9 +1341,9 @@ glasgowExtsFlags = [ Opt_PrintExplicitForalls , Opt_ForeignFunctionInterface , Opt_UnliftedFFITypes - , Opt_GADTs - , Opt_ImplicitParams - , Opt_ScopedTypeVariables + , Opt_GADTs + , Opt_ImplicitParams + , Opt_ScopedTypeVariables , Opt_UnboxedTuples , Opt_TypeSynonymInstances , Opt_StandaloneDeriving @@ -1332,13 +1353,14 @@ glasgowExtsFlags = [ , 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 @@ -1346,7 +1368,7 @@ glasgowExtsFlags = [ , Opt_KindSignatures , Opt_PatternSignatures , Opt_GeneralizedNewtypeDeriving - , Opt_TypeFamilies ] + , Opt_TypeFamilies ] ------------------ isFlag :: [(String,a)] -> String -> Bool