diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2020-03-05 11:17:46 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-03-11 20:33:37 -0400 |
commit | 8e6febcee4b91a88a5027baac4bee5a8847fe79b (patch) | |
tree | 52e17447417df5f410ea4e571ea5df7ead752bb8 /compiler/GHC | |
parent | 3aa9b35fcc417ab39d8da633482fe64dc9f898b1 (diff) | |
download | haskell-8e6febcee4b91a88a5027baac4bee5a8847fe79b.tar.gz |
Refactor GHC.Driver.Session (Ways and Flags)
* extract flags and ways into their own modules (with some renaming)
* remove one SOURCE import of GHC.Driver.Session from GHC.Driver.Phases
* when GHC uses dynamic linking (WayDyn), `interpWays` was only
reporting WayDyn even if the host was profiled (WayProf). Now it
returns both as expected (might fix #16803).
* `mkBuildTag :: [Way] -> String` wasn't reporting a canonical tag for
differently ordered lists. Now we sort and nub the list to fix this.
Diffstat (limited to 'compiler/GHC')
-rw-r--r-- | compiler/GHC/CoreToByteCode.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Driver/Flags.hs | 524 | ||||
-rw-r--r-- | compiler/GHC/Driver/MakeFile.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Driver/Packages.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Driver/Phases.hs | 13 | ||||
-rw-r--r-- | compiler/GHC/Driver/Pipeline.hs | 7 | ||||
-rw-r--r-- | compiler/GHC/Driver/Session.hs | 689 | ||||
-rw-r--r-- | compiler/GHC/Driver/Session.hs-boot | 2 | ||||
-rw-r--r-- | compiler/GHC/Driver/Ways.hs | 191 | ||||
-rw-r--r-- | compiler/GHC/Runtime/Linker.hs | 23 |
10 files changed, 752 insertions, 706 deletions
diff --git a/compiler/GHC/CoreToByteCode.hs b/compiler/GHC/CoreToByteCode.hs index a9c3ce3711..241066c2b3 100644 --- a/compiler/GHC/CoreToByteCode.hs +++ b/compiler/GHC/CoreToByteCode.hs @@ -24,6 +24,7 @@ import GHCi.FFI import GHCi.RemoteTypes import BasicTypes import GHC.Driver.Session +import GHC.Driver.Ways import Outputable import GHC.Platform import Name @@ -996,7 +997,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple let profiling | Just (ExternalInterp _) <- hsc_interp hsc_env = gopt Opt_SccProfilingOn dflags - | otherwise = rtsIsProfiled + | otherwise = hostIsProfiled -- Top of stack is the return itbl, as usual. -- underneath it is the pointer to the alt_code BCO. diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs new file mode 100644 index 0000000000..ec3de7a14a --- /dev/null +++ b/compiler/GHC/Driver/Flags.hs @@ -0,0 +1,524 @@ +module GHC.Driver.Flags + ( DumpFlag(..) + , GeneralFlag(..) + , WarningFlag(..) + , WarnReason (..) + , Language(..) + , optimisationFlags + ) +where + +import GhcPrelude +import Outputable +import EnumSet +import Json + +-- | Debugging flags +data DumpFlag +-- See Note [Updating flag description in the User's Guide] + + -- debugging flags + = Opt_D_dump_cmm + | Opt_D_dump_cmm_from_stg + | Opt_D_dump_cmm_raw + | Opt_D_dump_cmm_verbose_by_proc + -- All of the cmm subflags (there are a lot!) automatically + -- enabled if you run -ddump-cmm-verbose-by-proc + -- Each flag corresponds to exact stage of Cmm pipeline. + | Opt_D_dump_cmm_verbose + -- same as -ddump-cmm-verbose-by-proc but writes each stage + -- to a separate file (if used with -ddump-to-file) + | Opt_D_dump_cmm_cfg + | Opt_D_dump_cmm_cbe + | Opt_D_dump_cmm_switch + | Opt_D_dump_cmm_proc + | Opt_D_dump_cmm_sp + | Opt_D_dump_cmm_sink + | Opt_D_dump_cmm_caf + | Opt_D_dump_cmm_procmap + | Opt_D_dump_cmm_split + | Opt_D_dump_cmm_info + | Opt_D_dump_cmm_cps + -- end cmm subflags + | Opt_D_dump_cfg_weights -- ^ Dump the cfg used for block layout. + | Opt_D_dump_asm + | Opt_D_dump_asm_native + | Opt_D_dump_asm_liveness + | Opt_D_dump_asm_regalloc + | Opt_D_dump_asm_regalloc_stages + | Opt_D_dump_asm_conflicts + | Opt_D_dump_asm_stats + | Opt_D_dump_asm_expanded + | Opt_D_dump_llvm + | Opt_D_dump_core_stats + | Opt_D_dump_deriv + | Opt_D_dump_ds + | Opt_D_dump_ds_preopt + | Opt_D_dump_foreign + | Opt_D_dump_inlinings + | Opt_D_dump_rule_firings + | Opt_D_dump_rule_rewrites + | Opt_D_dump_simpl_trace + | Opt_D_dump_occur_anal + | Opt_D_dump_parsed + | Opt_D_dump_parsed_ast + | Opt_D_dump_rn + | Opt_D_dump_rn_ast + | Opt_D_dump_simpl + | Opt_D_dump_simpl_iterations + | Opt_D_dump_spec + | Opt_D_dump_prep + | Opt_D_dump_stg -- CoreToStg output + | Opt_D_dump_stg_unarised -- STG after unarise + | Opt_D_dump_stg_final -- STG after stg2stg + | Opt_D_dump_call_arity + | Opt_D_dump_exitify + | Opt_D_dump_stranal + | Opt_D_dump_str_signatures + | Opt_D_dump_cpranal + | Opt_D_dump_cpr_signatures + | Opt_D_dump_tc + | Opt_D_dump_tc_ast + | Opt_D_dump_types + | Opt_D_dump_rules + | Opt_D_dump_cse + | Opt_D_dump_worker_wrapper + | Opt_D_dump_rn_trace + | Opt_D_dump_rn_stats + | Opt_D_dump_opt_cmm + | Opt_D_dump_simpl_stats + | Opt_D_dump_cs_trace -- Constraint solver in type checker + | Opt_D_dump_tc_trace + | Opt_D_dump_ec_trace -- Pattern match exhaustiveness checker + | Opt_D_dump_if_trace + | Opt_D_dump_vt_trace + | Opt_D_dump_splices + | Opt_D_th_dec_file + | Opt_D_dump_BCOs + | Opt_D_dump_ticked + | Opt_D_dump_rtti + | Opt_D_source_stats + | Opt_D_verbose_stg2stg + | Opt_D_dump_hi + | Opt_D_dump_hi_diffs + | Opt_D_dump_mod_cycles + | Opt_D_dump_mod_map + | Opt_D_dump_timings + | Opt_D_dump_view_pattern_commoning + | Opt_D_verbose_core2core + | Opt_D_dump_debug + | Opt_D_dump_json + | Opt_D_ppr_debug + | Opt_D_no_debug_output + deriving (Eq, Show, Enum) + +-- | Enumerates the simple on-or-off dynamic flags +data GeneralFlag +-- See Note [Updating flag description in the User's Guide] + + = Opt_DumpToFile -- ^ Append dump output to files instead of stdout. + | Opt_D_faststring_stats + | Opt_D_dump_minimal_imports + | Opt_DoCoreLinting + | Opt_DoStgLinting + | Opt_DoCmmLinting + | Opt_DoAsmLinting + | Opt_DoAnnotationLinting + | Opt_NoLlvmMangler -- hidden flag + | Opt_FastLlvm -- hidden flag + | Opt_NoTypeableBinds + + | Opt_WarnIsError -- -Werror; makes warnings fatal + | Opt_ShowWarnGroups -- Show the group a warning belongs to + | Opt_HideSourcePaths -- Hide module source/object paths + + | Opt_PrintExplicitForalls + | Opt_PrintExplicitKinds + | Opt_PrintExplicitCoercions + | Opt_PrintExplicitRuntimeReps + | Opt_PrintEqualityRelations + | Opt_PrintAxiomIncomps + | Opt_PrintUnicodeSyntax + | Opt_PrintExpandedSynonyms + | Opt_PrintPotentialInstances + | Opt_PrintTypecheckerElaboration + + -- optimisation opts + | Opt_CallArity + | Opt_Exitification + | Opt_Strictness + | Opt_LateDmdAnal -- #6087 + | Opt_KillAbsence + | Opt_KillOneShot + | Opt_FullLaziness + | Opt_FloatIn + | Opt_LateSpecialise + | Opt_Specialise + | Opt_SpecialiseAggressively + | Opt_CrossModuleSpecialise + | Opt_StaticArgumentTransformation + | Opt_CSE + | Opt_StgCSE + | Opt_StgLiftLams + | Opt_LiberateCase + | Opt_SpecConstr + | Opt_SpecConstrKeen + | Opt_DoLambdaEtaExpansion + | Opt_IgnoreAsserts + | Opt_DoEtaReduction + | Opt_CaseMerge + | Opt_CaseFolding -- Constant folding through case-expressions + | Opt_UnboxStrictFields + | Opt_UnboxSmallStrictFields + | Opt_DictsCheap + | Opt_EnableRewriteRules -- Apply rewrite rules during simplification + | Opt_EnableThSpliceWarnings -- Enable warnings for TH splices + | Opt_RegsGraph -- do graph coloring register allocation + | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation + | Opt_PedanticBottoms -- Be picky about how we treat bottom + | Opt_LlvmTBAA -- Use LLVM TBAA infrastructure for improving AA (hidden flag) + | Opt_LlvmFillUndefWithGarbage -- Testing for undef bugs (hidden flag) + | Opt_IrrefutableTuples + | Opt_CmmSink + | Opt_CmmElimCommonBlocks + | Opt_AsmShortcutting + | Opt_OmitYields + | Opt_FunToThunk -- allow WwLib.mkWorkerArgs to remove all value lambdas + | Opt_DictsStrict -- be strict in argument dictionaries + | Opt_DmdTxDictSel -- use a special demand transformer for dictionary selectors + | Opt_Loopification -- See Note [Self-recursive tail calls] + | Opt_CfgBlocklayout -- ^ Use the cfg based block layout algorithm. + | Opt_WeightlessBlocklayout -- ^ Layout based on last instruction per block. + | Opt_CprAnal + | Opt_WorkerWrapper + | Opt_SolveConstantDicts + | Opt_AlignmentSanitisation + | Opt_CatchBottoms + | Opt_NumConstantFolding + + -- PreInlining is on by default. The option is there just to see how + -- bad things get if you turn it off! + | Opt_SimplPreInlining + + -- Interface files + | Opt_IgnoreInterfacePragmas + | Opt_OmitInterfacePragmas + | Opt_ExposeAllUnfoldings + | Opt_WriteInterface -- forces .hi files to be written even with -fno-code + | Opt_WriteHie -- generate .hie files + + -- profiling opts + | Opt_AutoSccsOnIndividualCafs + | Opt_ProfCountEntries + + -- misc opts + | Opt_Pp + | Opt_ForceRecomp + | Opt_IgnoreOptimChanges + | Opt_IgnoreHpcChanges + | Opt_ExcessPrecision + | Opt_EagerBlackHoling + | Opt_NoHsMain + | Opt_SplitSections + | Opt_StgStats + | Opt_HideAllPackages + | Opt_HideAllPluginPackages + | Opt_PrintBindResult + | Opt_Haddock + | Opt_HaddockOptions + | Opt_BreakOnException + | Opt_BreakOnError + | Opt_PrintEvldWithShow + | Opt_PrintBindContents + | Opt_GenManifest + | Opt_EmbedManifest + | Opt_SharedImplib + | Opt_BuildingCabalPackage + | Opt_IgnoreDotGhci + | Opt_GhciSandbox + | Opt_GhciHistory + | Opt_GhciLeakCheck + | Opt_ValidateHie + | Opt_LocalGhciHistory + | Opt_NoIt + | Opt_HelpfulErrors + | Opt_DeferTypeErrors + | Opt_DeferTypedHoles + | Opt_DeferOutOfScopeVariables + | Opt_PIC -- ^ @-fPIC@ + | Opt_PIE -- ^ @-fPIE@ + | Opt_PICExecutable -- ^ @-pie@ + | Opt_ExternalDynamicRefs + | Opt_SccProfilingOn + | Opt_Ticky + | Opt_Ticky_Allocd + | Opt_Ticky_LNE + | Opt_Ticky_Dyn_Thunk + | Opt_RPath + | Opt_RelativeDynlibPaths + | Opt_Hpc + | Opt_FlatCache + | Opt_ExternalInterpreter + | Opt_OptimalApplicativeDo + | Opt_VersionMacros + | Opt_WholeArchiveHsLibs + -- copy all libs into a single folder prior to linking binaries + -- this should elivate the excessive command line limit restrictions + -- on windows, by only requiring a single -L argument instead of + -- one for each dependency. At the time of this writing, gcc + -- forwards all -L flags to the collect2 command without using a + -- response file and as such breaking apart. + | Opt_SingleLibFolder + | Opt_KeepCAFs + | Opt_KeepGoing + | Opt_ByteCode + + -- output style opts + | Opt_ErrorSpans -- Include full span info in error messages, + -- instead of just the start position. + | Opt_DeferDiagnostics + | Opt_DiagnosticsShowCaret -- Show snippets of offending code + | Opt_PprCaseAsLet + | Opt_PprShowTicks + | Opt_ShowHoleConstraints + -- Options relating to the display of valid hole fits + -- when generating an error message for a typed hole + -- See Note [Valid hole fits include] in TcHoleErrors.hs + | Opt_ShowValidHoleFits + | Opt_SortValidHoleFits + | Opt_SortBySizeHoleFits + | Opt_SortBySubsumHoleFits + | Opt_AbstractRefHoleFits + | Opt_UnclutterValidHoleFits + | Opt_ShowTypeAppOfHoleFits + | Opt_ShowTypeAppVarsOfHoleFits + | Opt_ShowDocsOfHoleFits + | Opt_ShowTypeOfHoleFits + | Opt_ShowProvOfHoleFits + | Opt_ShowMatchesOfHoleFits + + | Opt_ShowLoadedModules + | Opt_HexWordLiterals -- See Note [Print Hexadecimal Literals] + + -- Suppress all coercions, them replacing with '...' + | Opt_SuppressCoercions + | Opt_SuppressVarKinds + -- Suppress module id prefixes on variables. + | Opt_SuppressModulePrefixes + -- Suppress type applications. + | Opt_SuppressTypeApplications + -- Suppress info such as arity and unfoldings on identifiers. + | Opt_SuppressIdInfo + -- Suppress separate type signatures in core, but leave types on + -- lambda bound vars + | Opt_SuppressUnfoldings + -- Suppress the details of even stable unfoldings + | Opt_SuppressTypeSignatures + -- Suppress unique ids on variables. + -- Except for uniques, as some simplifier phases introduce new + -- variables that have otherwise identical names. + | Opt_SuppressUniques + | Opt_SuppressStgExts + | Opt_SuppressTicks -- Replaces Opt_PprShowTicks + | Opt_SuppressTimestamps -- ^ Suppress timestamps in dumps + + -- temporary flags + | Opt_AutoLinkPackages + | Opt_ImplicitImportQualified + + -- keeping stuff + | Opt_KeepHscppFiles + | Opt_KeepHiDiffs + | Opt_KeepHcFiles + | Opt_KeepSFiles + | Opt_KeepTmpFiles + | Opt_KeepRawTokenStream + | Opt_KeepLlvmFiles + | Opt_KeepHiFiles + | Opt_KeepOFiles + + | Opt_BuildDynamicToo + + -- safe haskell flags + | Opt_DistrustAllPackages + | Opt_PackageTrust + | Opt_PluginTrustworthy + + | Opt_G_NoStateHack + | Opt_G_NoOptCoercion + deriving (Eq, Show, Enum) + +-- Check whether a flag should be considered an "optimisation flag" +-- for purposes of recompilation avoidance (see +-- Note [Ignoring some flag changes] in FlagChecker). Being listed here is +-- not a guarantee that the flag has no other effect. We could, and +-- perhaps should, separate out the flags that have some minor impact on +-- program semantics and/or error behavior (e.g., assertions), but +-- then we'd need to go to extra trouble (and an additional flag) +-- to allow users to ignore the optimisation level even though that +-- means ignoring some change. +optimisationFlags :: EnumSet GeneralFlag +optimisationFlags = EnumSet.fromList + [ Opt_CallArity + , Opt_Strictness + , Opt_LateDmdAnal + , Opt_KillAbsence + , Opt_KillOneShot + , Opt_FullLaziness + , Opt_FloatIn + , Opt_LateSpecialise + , Opt_Specialise + , Opt_SpecialiseAggressively + , Opt_CrossModuleSpecialise + , Opt_StaticArgumentTransformation + , Opt_CSE + , Opt_StgCSE + , Opt_StgLiftLams + , Opt_LiberateCase + , Opt_SpecConstr + , Opt_SpecConstrKeen + , Opt_DoLambdaEtaExpansion + , Opt_IgnoreAsserts + , Opt_DoEtaReduction + , Opt_CaseMerge + , Opt_CaseFolding + , Opt_UnboxStrictFields + , Opt_UnboxSmallStrictFields + , Opt_DictsCheap + , Opt_EnableRewriteRules + , Opt_RegsGraph + , Opt_RegsIterative + , Opt_PedanticBottoms + , Opt_LlvmTBAA + , Opt_LlvmFillUndefWithGarbage + , Opt_IrrefutableTuples + , Opt_CmmSink + , Opt_CmmElimCommonBlocks + , Opt_AsmShortcutting + , Opt_OmitYields + , Opt_FunToThunk + , Opt_DictsStrict + , Opt_DmdTxDictSel + , Opt_Loopification + , Opt_CfgBlocklayout + , Opt_WeightlessBlocklayout + , Opt_CprAnal + , Opt_WorkerWrapper + , Opt_SolveConstantDicts + , Opt_CatchBottoms + , Opt_IgnoreAsserts + ] + +data WarningFlag = +-- See Note [Updating flag description in the User's Guide] + Opt_WarnDuplicateExports + | Opt_WarnDuplicateConstraints + | Opt_WarnRedundantConstraints + | Opt_WarnHiShadows + | Opt_WarnImplicitPrelude + | Opt_WarnIncompletePatterns + | Opt_WarnIncompleteUniPatterns + | Opt_WarnIncompletePatternsRecUpd + | Opt_WarnOverflowedLiterals + | Opt_WarnEmptyEnumerations + | Opt_WarnMissingFields + | Opt_WarnMissingImportList + | Opt_WarnMissingMethods + | Opt_WarnMissingSignatures + | Opt_WarnMissingLocalSignatures + | Opt_WarnNameShadowing + | Opt_WarnOverlappingPatterns + | Opt_WarnTypeDefaults + | Opt_WarnMonomorphism + | Opt_WarnUnusedTopBinds + | Opt_WarnUnusedLocalBinds + | Opt_WarnUnusedPatternBinds + | Opt_WarnUnusedImports + | Opt_WarnUnusedMatches + | Opt_WarnUnusedTypePatterns + | Opt_WarnUnusedForalls + | Opt_WarnUnusedRecordWildcards + | Opt_WarnRedundantRecordWildcards + | Opt_WarnWarningsDeprecations + | Opt_WarnDeprecatedFlags + | Opt_WarnMissingMonadFailInstances -- since 8.0, has no effect since 8.8 + | Opt_WarnSemigroup -- since 8.0 + | Opt_WarnDodgyExports + | Opt_WarnDodgyImports + | Opt_WarnOrphans + | Opt_WarnAutoOrphans + | Opt_WarnIdentities + | Opt_WarnTabs + | Opt_WarnUnrecognisedPragmas + | Opt_WarnDodgyForeignImports + | Opt_WarnUnusedDoBind + | Opt_WarnWrongDoBind + | Opt_WarnAlternativeLayoutRuleTransitional + | Opt_WarnUnsafe + | Opt_WarnSafe + | Opt_WarnTrustworthySafe + | Opt_WarnMissedSpecs + | Opt_WarnAllMissedSpecs + | Opt_WarnUnsupportedCallingConventions + | Opt_WarnUnsupportedLlvmVersion + | Opt_WarnMissedExtraSharedLib + | Opt_WarnInlineRuleShadowing + | Opt_WarnTypedHoles + | Opt_WarnPartialTypeSignatures + | Opt_WarnMissingExportedSignatures + | Opt_WarnUntickedPromotedConstructors + | Opt_WarnDerivingTypeable + | Opt_WarnDeferredTypeErrors + | Opt_WarnDeferredOutOfScopeVariables + | Opt_WarnNonCanonicalMonadInstances -- since 8.0 + | Opt_WarnNonCanonicalMonadFailInstances -- since 8.0, removed 8.8 + | Opt_WarnNonCanonicalMonoidInstances -- since 8.0 + | Opt_WarnMissingPatternSynonymSignatures -- since 8.0 + | Opt_WarnUnrecognisedWarningFlags -- since 8.0 + | Opt_WarnSimplifiableClassConstraints -- Since 8.2 + | Opt_WarnCPPUndef -- Since 8.2 + | Opt_WarnUnbangedStrictPatterns -- Since 8.2 + | Opt_WarnMissingHomeModules -- Since 8.2 + | Opt_WarnPartialFields -- Since 8.4 + | Opt_WarnMissingExportList + | Opt_WarnInaccessibleCode + | Opt_WarnStarIsType -- Since 8.6 + | Opt_WarnStarBinder -- Since 8.6 + | Opt_WarnImplicitKindVars -- Since 8.6 + | Opt_WarnSpaceAfterBang + | Opt_WarnMissingDerivingStrategies -- Since 8.8 + | Opt_WarnPrepositiveQualifiedModule -- Since TBD + | Opt_WarnUnusedPackages -- Since 8.10 + | Opt_WarnInferredSafeImports -- Since 8.10 + | Opt_WarnMissingSafeHaskellMode -- Since 8.10 + | Opt_WarnCompatUnqualifiedImports -- Since 8.10 + | Opt_WarnDerivingDefaults + deriving (Eq, Show, Enum) + +-- | Used when outputting warnings: if a reason is given, it is +-- displayed. If a warning isn't controlled by a flag, this is made +-- explicit at the point of use. +data WarnReason + = NoReason + -- | Warning was enabled with the flag + | Reason !WarningFlag + -- | Warning was made an error because of -Werror or -Werror=WarningFlag + | ErrReason !(Maybe WarningFlag) + deriving Show + +instance Outputable WarnReason where + ppr = text . show + +instance ToJson WarnReason where + json NoReason = JSNull + json (Reason wf) = JSString (show wf) + json (ErrReason Nothing) = JSString "Opt_WarnIsError" + json (ErrReason (Just wf)) = JSString (show wf) + + +data Language = Haskell98 | Haskell2010 + deriving (Eq, Enum, Show) + +instance Outputable Language where + ppr = text . show + diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs index d1d3b00394..bbd501fb26 100644 --- a/compiler/GHC/Driver/MakeFile.hs +++ b/compiler/GHC/Driver/MakeFile.hs @@ -63,7 +63,7 @@ doMkDependHS srcs = do -- be specified. let dflags = dflags0 { ways = [], - buildTag = mkBuildTag [], + buildTag = waysTag [], hiSuf = "hi", objectSuf = "o" } diff --git a/compiler/GHC/Driver/Packages.hs b/compiler/GHC/Driver/Packages.hs index 572da5f3d1..09eac60308 100644 --- a/compiler/GHC/Driver/Packages.hs +++ b/compiler/GHC/Driver/Packages.hs @@ -1849,8 +1849,8 @@ packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p) | otherwise = ways1 - tag = mkBuildTag (filter (not . wayRTSOnly) ways2) - rts_tag = mkBuildTag ways2 + tag = waysTag (filter (not . wayRTSOnly) ways2) + rts_tag = waysTag ways2 mkDynName x | WayDyn `notElem` ways dflags = x diff --git a/compiler/GHC/Driver/Phases.hs b/compiler/GHC/Driver/Phases.hs index 45cb4656ba..d9059f65ec 100644 --- a/compiler/GHC/Driver/Phases.hs +++ b/compiler/GHC/Driver/Phases.hs @@ -41,7 +41,6 @@ module GHC.Driver.Phases ( import GhcPrelude -import {-# SOURCE #-} GHC.Driver.Session import Outputable import GHC.Platform import System.FilePath @@ -198,15 +197,15 @@ use of -C with registerised builds (in Main.checkOptions), it is still possible for a ghc-api user to do so. So be careful when using the function happensBefore, and don't think that `not (a <= b)` implies `b < a`. -} -happensBefore :: DynFlags -> Phase -> Phase -> Bool -happensBefore dflags p1 p2 = p1 `happensBefore'` p2 +happensBefore :: Platform -> Phase -> Phase -> Bool +happensBefore platform p1 p2 = p1 `happensBefore'` p2 where StopLn `happensBefore'` _ = False x `happensBefore'` y = after_x `eqPhase` y || after_x `happensBefore'` y - where after_x = nextPhase dflags x + where after_x = nextPhase platform x -nextPhase :: DynFlags -> Phase -> Phase -nextPhase dflags p +nextPhase :: Platform -> Phase -> Phase +nextPhase platform p -- A conservative approximation to the next phase, used in happensBefore = case p of Unlit sf -> Cpp sf @@ -226,7 +225,7 @@ nextPhase dflags p HCc -> As False MergeForeign -> StopLn StopLn -> panic "nextPhase: nothing after StopLn" - where maybeHCc = if platformUnregisterised (targetPlatform dflags) + where maybeHCc = if platformUnregisterised platform then HCc else As False diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs index 7a7448888d..e879133467 100644 --- a/compiler/GHC/Driver/Pipeline.hs +++ b/compiler/GHC/Driver/Pipeline.hs @@ -40,6 +40,7 @@ import GhcPrelude import GHC.Driver.Pipeline.Monad import GHC.Driver.Packages +import GHC.Driver.Ways import HeaderInfo import GHC.Driver.Phases import SysTools @@ -288,7 +289,7 @@ compileOne' m_tc_result mHscMessage -- #8180 - when using TemplateHaskell, switch on -dynamic-too so -- the linker can correctly load the object files. This isn't necessary -- when using -fexternal-interpreter. - dflags1 = if dynamicGhc && internalInterpreter && + dflags1 = if hostIsDynamic && internalInterpreter && not isDynWay && not isProfWay && needsLinker then gopt_set dflags0 Opt_BuildDynamicToo else dflags0 @@ -650,7 +651,7 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_input_buf, mb_phase) -- We want to catch cases of "you can't get there from here" before -- we start the pipeline, because otherwise it will just run off the -- end. - let happensBefore' = happensBefore dflags + let happensBefore' = happensBefore (targetPlatform dflags) case start_phase of RealPhase start_phase' -> -- See Note [Partial ordering on phases] @@ -722,7 +723,7 @@ pipeLoop phase input_fn = do env <- getPipeEnv dflags <- getDynFlags -- See Note [Partial ordering on phases] - let happensBefore' = happensBefore dflags + let happensBefore' = happensBefore (targetPlatform dflags) stopPhase = stop_phase env case phase of RealPhase realPhase | realPhase `eqPhase` stopPhase -- All done diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index 7bad61c93d..af0783d6a0 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -64,7 +64,7 @@ module GHC.Driver.Session ( optimisationFlags, setFlagsFromEnvFile, - Way(..), mkBuildTag, wayRTSOnly, addWay', updateWays, + Way(..), waysTag, wayRTSOnly, addWay', updateWays, wayGeneralFlags, wayUnsetGeneralFlags, thisPackage, thisComponentId, thisUnitIdInsts, @@ -162,7 +162,6 @@ module GHC.Driver.Session ( addPluginModuleName, defaultDynFlags, -- Settings -> DynFlags defaultWays, - interpWays, interpreterProfiled, interpreterDynamic, initDynFlags, -- DynFlags -> IO DynFlags defaultFatalMessager, @@ -201,9 +200,6 @@ module GHC.Driver.Session ( -- * Compiler configuration suitable for display to the user compilerInfo, - rtsIsProfiled, - dynamicGhc, - #include "GHCConstantsHaskellExports.hs" bLOCK_SIZE_W, wORD_SIZE_IN_BITS, @@ -257,6 +253,8 @@ import {-# SOURCE #-} GHC.Driver.Hooks import {-# SOURCE #-} PrelNames ( mAIN ) import {-# SOURCE #-} GHC.Driver.Packages (PackageState, emptyPackageState, PackageDatabase) import GHC.Driver.Phases ( Phase(..), phaseInputExt ) +import GHC.Driver.Flags +import GHC.Driver.Ways import Config import CliOption import GHC.Driver.CmdLine hiding (WarnReason(..)) @@ -278,8 +276,6 @@ import Outputable import Settings import ToolSettings -import Foreign.C ( CInt(..) ) -import System.IO.Unsafe ( unsafeDupablePerformIO ) import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessageAnn , getCaretDiagnostic, DumpAction, TraceAction , defaultDumpAction, defaultTraceAction ) @@ -400,412 +396,6 @@ import Foreign (Ptr) -- ----------------------------------------------------------------------------- -- DynFlags -data DumpFlag --- See Note [Updating flag description in the User's Guide] - - -- debugging flags - = Opt_D_dump_cmm - | Opt_D_dump_cmm_from_stg - | Opt_D_dump_cmm_raw - | Opt_D_dump_cmm_verbose_by_proc - -- All of the cmm subflags (there are a lot!) automatically - -- enabled if you run -ddump-cmm-verbose-by-proc - -- Each flag corresponds to exact stage of Cmm pipeline. - | Opt_D_dump_cmm_verbose - -- same as -ddump-cmm-verbose-by-proc but writes each stage - -- to a separate file (if used with -ddump-to-file) - | Opt_D_dump_cmm_cfg - | Opt_D_dump_cmm_cbe - | Opt_D_dump_cmm_switch - | Opt_D_dump_cmm_proc - | Opt_D_dump_cmm_sp - | Opt_D_dump_cmm_sink - | Opt_D_dump_cmm_caf - | Opt_D_dump_cmm_procmap - | Opt_D_dump_cmm_split - | Opt_D_dump_cmm_info - | Opt_D_dump_cmm_cps - -- end cmm subflags - | Opt_D_dump_cfg_weights -- ^ Dump the cfg used for block layout. - | Opt_D_dump_asm - | Opt_D_dump_asm_native - | Opt_D_dump_asm_liveness - | Opt_D_dump_asm_regalloc - | Opt_D_dump_asm_regalloc_stages - | Opt_D_dump_asm_conflicts - | Opt_D_dump_asm_stats - | Opt_D_dump_asm_expanded - | Opt_D_dump_llvm - | Opt_D_dump_core_stats - | Opt_D_dump_deriv - | Opt_D_dump_ds - | Opt_D_dump_ds_preopt - | Opt_D_dump_foreign - | Opt_D_dump_inlinings - | Opt_D_dump_rule_firings - | Opt_D_dump_rule_rewrites - | Opt_D_dump_simpl_trace - | Opt_D_dump_occur_anal - | Opt_D_dump_parsed - | Opt_D_dump_parsed_ast - | Opt_D_dump_rn - | Opt_D_dump_rn_ast - | Opt_D_dump_simpl - | Opt_D_dump_simpl_iterations - | Opt_D_dump_spec - | Opt_D_dump_prep - | Opt_D_dump_stg -- CoreToStg output - | Opt_D_dump_stg_unarised -- STG after unarise - | Opt_D_dump_stg_final -- STG after stg2stg - | Opt_D_dump_call_arity - | Opt_D_dump_exitify - | Opt_D_dump_stranal - | Opt_D_dump_str_signatures - | Opt_D_dump_cpranal - | Opt_D_dump_cpr_signatures - | Opt_D_dump_tc - | Opt_D_dump_tc_ast - | Opt_D_dump_types - | Opt_D_dump_rules - | Opt_D_dump_cse - | Opt_D_dump_worker_wrapper - | Opt_D_dump_rn_trace - | Opt_D_dump_rn_stats - | Opt_D_dump_opt_cmm - | Opt_D_dump_simpl_stats - | Opt_D_dump_cs_trace -- Constraint solver in type checker - | Opt_D_dump_tc_trace - | Opt_D_dump_ec_trace -- Pattern match exhaustiveness checker - | Opt_D_dump_if_trace - | Opt_D_dump_vt_trace - | Opt_D_dump_splices - | Opt_D_th_dec_file - | Opt_D_dump_BCOs - | Opt_D_dump_ticked - | Opt_D_dump_rtti - | Opt_D_source_stats - | Opt_D_verbose_stg2stg - | Opt_D_dump_hi - | Opt_D_dump_hi_diffs - | Opt_D_dump_mod_cycles - | Opt_D_dump_mod_map - | Opt_D_dump_timings - | Opt_D_dump_view_pattern_commoning - | Opt_D_verbose_core2core - | Opt_D_dump_debug - | Opt_D_dump_json - | Opt_D_ppr_debug - | Opt_D_no_debug_output - deriving (Eq, Show, Enum) - - --- | Enumerates the simple on-or-off dynamic flags -data GeneralFlag --- See Note [Updating flag description in the User's Guide] - - = Opt_DumpToFile -- ^ Append dump output to files instead of stdout. - | Opt_D_faststring_stats - | Opt_D_dump_minimal_imports - | Opt_DoCoreLinting - | Opt_DoStgLinting - | Opt_DoCmmLinting - | Opt_DoAsmLinting - | Opt_DoAnnotationLinting - | Opt_NoLlvmMangler -- hidden flag - | Opt_FastLlvm -- hidden flag - | Opt_NoTypeableBinds - - | Opt_WarnIsError -- -Werror; makes warnings fatal - | Opt_ShowWarnGroups -- Show the group a warning belongs to - | Opt_HideSourcePaths -- Hide module source/object paths - - | Opt_PrintExplicitForalls - | Opt_PrintExplicitKinds - | Opt_PrintExplicitCoercions - | Opt_PrintExplicitRuntimeReps - | Opt_PrintEqualityRelations - | Opt_PrintAxiomIncomps - | Opt_PrintUnicodeSyntax - | Opt_PrintExpandedSynonyms - | Opt_PrintPotentialInstances - | Opt_PrintTypecheckerElaboration - - -- optimisation opts - | Opt_CallArity - | Opt_Exitification - | Opt_Strictness - | Opt_LateDmdAnal -- #6087 - | Opt_KillAbsence - | Opt_KillOneShot - | Opt_FullLaziness - | Opt_FloatIn - | Opt_LateSpecialise - | Opt_Specialise - | Opt_SpecialiseAggressively - | Opt_CrossModuleSpecialise - | Opt_StaticArgumentTransformation - | Opt_CSE - | Opt_StgCSE - | Opt_StgLiftLams - | Opt_LiberateCase - | Opt_SpecConstr - | Opt_SpecConstrKeen - | Opt_DoLambdaEtaExpansion - | Opt_IgnoreAsserts - | Opt_DoEtaReduction - | Opt_CaseMerge - | Opt_CaseFolding -- Constant folding through case-expressions - | Opt_UnboxStrictFields - | Opt_UnboxSmallStrictFields - | Opt_DictsCheap - | Opt_EnableRewriteRules -- Apply rewrite rules during simplification - | Opt_EnableThSpliceWarnings -- Enable warnings for TH splices - | Opt_RegsGraph -- do graph coloring register allocation - | Opt_RegsIterative -- do iterative coalescing graph coloring register allocation - | Opt_PedanticBottoms -- Be picky about how we treat bottom - | Opt_LlvmTBAA -- Use LLVM TBAA infrastructure for improving AA (hidden flag) - | Opt_LlvmFillUndefWithGarbage -- Testing for undef bugs (hidden flag) - | Opt_IrrefutableTuples - | Opt_CmmSink - | Opt_CmmElimCommonBlocks - | Opt_AsmShortcutting - | Opt_OmitYields - | Opt_FunToThunk -- allow WwLib.mkWorkerArgs to remove all value lambdas - | Opt_DictsStrict -- be strict in argument dictionaries - | Opt_DmdTxDictSel -- use a special demand transformer for dictionary selectors - | Opt_Loopification -- See Note [Self-recursive tail calls] - | Opt_CfgBlocklayout -- ^ Use the cfg based block layout algorithm. - | Opt_WeightlessBlocklayout -- ^ Layout based on last instruction per block. - | Opt_CprAnal - | Opt_WorkerWrapper - | Opt_SolveConstantDicts - | Opt_AlignmentSanitisation - | Opt_CatchBottoms - | Opt_NumConstantFolding - - -- PreInlining is on by default. The option is there just to see how - -- bad things get if you turn it off! - | Opt_SimplPreInlining - - -- Interface files - | Opt_IgnoreInterfacePragmas - | Opt_OmitInterfacePragmas - | Opt_ExposeAllUnfoldings - | Opt_WriteInterface -- forces .hi files to be written even with -fno-code - | Opt_WriteHie -- generate .hie files - - -- profiling opts - | Opt_AutoSccsOnIndividualCafs - | Opt_ProfCountEntries - - -- misc opts - | Opt_Pp - | Opt_ForceRecomp - | Opt_IgnoreOptimChanges - | Opt_IgnoreHpcChanges - | Opt_ExcessPrecision - | Opt_EagerBlackHoling - | Opt_NoHsMain - | Opt_SplitSections - | Opt_StgStats - | Opt_HideAllPackages - | Opt_HideAllPluginPackages - | Opt_PrintBindResult - | Opt_Haddock - | Opt_HaddockOptions - | Opt_BreakOnException - | Opt_BreakOnError - | Opt_PrintEvldWithShow - | Opt_PrintBindContents - | Opt_GenManifest - | Opt_EmbedManifest - | Opt_SharedImplib - | Opt_BuildingCabalPackage - | Opt_IgnoreDotGhci - | Opt_GhciSandbox - | Opt_GhciHistory - | Opt_GhciLeakCheck - | Opt_ValidateHie - | Opt_LocalGhciHistory - | Opt_NoIt - | Opt_HelpfulErrors - | Opt_DeferTypeErrors - | Opt_DeferTypedHoles - | Opt_DeferOutOfScopeVariables - | Opt_PIC -- ^ @-fPIC@ - | Opt_PIE -- ^ @-fPIE@ - | Opt_PICExecutable -- ^ @-pie@ - | Opt_ExternalDynamicRefs - | Opt_SccProfilingOn - | Opt_Ticky - | Opt_Ticky_Allocd - | Opt_Ticky_LNE - | Opt_Ticky_Dyn_Thunk - | Opt_RPath - | Opt_RelativeDynlibPaths - | Opt_Hpc - | Opt_FlatCache - | Opt_ExternalInterpreter - | Opt_OptimalApplicativeDo - | Opt_VersionMacros - | Opt_WholeArchiveHsLibs - -- copy all libs into a single folder prior to linking binaries - -- this should elivate the excessive command line limit restrictions - -- on windows, by only requiring a single -L argument instead of - -- one for each dependency. At the time of this writing, gcc - -- forwards all -L flags to the collect2 command without using a - -- response file and as such breaking apart. - | Opt_SingleLibFolder - | Opt_KeepCAFs - | Opt_KeepGoing - | Opt_ByteCode - - -- output style opts - | Opt_ErrorSpans -- Include full span info in error messages, - -- instead of just the start position. - | Opt_DeferDiagnostics - | Opt_DiagnosticsShowCaret -- Show snippets of offending code - | Opt_PprCaseAsLet - | Opt_PprShowTicks - | Opt_ShowHoleConstraints - -- Options relating to the display of valid hole fits - -- when generating an error message for a typed hole - -- See Note [Valid hole fits include] in TcHoleErrors.hs - | Opt_ShowValidHoleFits - | Opt_SortValidHoleFits - | Opt_SortBySizeHoleFits - | Opt_SortBySubsumHoleFits - | Opt_AbstractRefHoleFits - | Opt_UnclutterValidHoleFits - | Opt_ShowTypeAppOfHoleFits - | Opt_ShowTypeAppVarsOfHoleFits - | Opt_ShowDocsOfHoleFits - | Opt_ShowTypeOfHoleFits - | Opt_ShowProvOfHoleFits - | Opt_ShowMatchesOfHoleFits - - | Opt_ShowLoadedModules - | Opt_HexWordLiterals -- See Note [Print Hexadecimal Literals] - - -- Suppress all coercions, them replacing with '...' - | Opt_SuppressCoercions - | Opt_SuppressVarKinds - -- Suppress module id prefixes on variables. - | Opt_SuppressModulePrefixes - -- Suppress type applications. - | Opt_SuppressTypeApplications - -- Suppress info such as arity and unfoldings on identifiers. - | Opt_SuppressIdInfo - -- Suppress separate type signatures in core, but leave types on - -- lambda bound vars - | Opt_SuppressUnfoldings - -- Suppress the details of even stable unfoldings - | Opt_SuppressTypeSignatures - -- Suppress unique ids on variables. - -- Except for uniques, as some simplifier phases introduce new - -- variables that have otherwise identical names. - | Opt_SuppressUniques - | Opt_SuppressStgExts - | Opt_SuppressTicks -- Replaces Opt_PprShowTicks - | Opt_SuppressTimestamps -- ^ Suppress timestamps in dumps - - -- temporary flags - | Opt_AutoLinkPackages - | Opt_ImplicitImportQualified - - -- keeping stuff - | Opt_KeepHscppFiles - | Opt_KeepHiDiffs - | Opt_KeepHcFiles - | Opt_KeepSFiles - | Opt_KeepTmpFiles - | Opt_KeepRawTokenStream - | Opt_KeepLlvmFiles - | Opt_KeepHiFiles - | Opt_KeepOFiles - - | Opt_BuildDynamicToo - - -- safe haskell flags - | Opt_DistrustAllPackages - | Opt_PackageTrust - | Opt_PluginTrustworthy - - | Opt_G_NoStateHack - | Opt_G_NoOptCoercion - deriving (Eq, Show, Enum) - --- Check whether a flag should be considered an "optimisation flag" --- for purposes of recompilation avoidance (see --- Note [Ignoring some flag changes] in FlagChecker). Being listed here is --- not a guarantee that the flag has no other effect. We could, and --- perhaps should, separate out the flags that have some minor impact on --- program semantics and/or error behavior (e.g., assertions), but --- then we'd need to go to extra trouble (and an additional flag) --- to allow users to ignore the optimisation level even though that --- means ignoring some change. -optimisationFlags :: EnumSet GeneralFlag -optimisationFlags = EnumSet.fromList - [ Opt_CallArity - , Opt_Strictness - , Opt_LateDmdAnal - , Opt_KillAbsence - , Opt_KillOneShot - , Opt_FullLaziness - , Opt_FloatIn - , Opt_LateSpecialise - , Opt_Specialise - , Opt_SpecialiseAggressively - , Opt_CrossModuleSpecialise - , Opt_StaticArgumentTransformation - , Opt_CSE - , Opt_StgCSE - , Opt_StgLiftLams - , Opt_LiberateCase - , Opt_SpecConstr - , Opt_SpecConstrKeen - , Opt_DoLambdaEtaExpansion - , Opt_IgnoreAsserts - , Opt_DoEtaReduction - , Opt_CaseMerge - , Opt_CaseFolding - , Opt_UnboxStrictFields - , Opt_UnboxSmallStrictFields - , Opt_DictsCheap - , Opt_EnableRewriteRules - , Opt_RegsGraph - , Opt_RegsIterative - , Opt_PedanticBottoms - , Opt_LlvmTBAA - , Opt_LlvmFillUndefWithGarbage - , Opt_IrrefutableTuples - , Opt_CmmSink - , Opt_CmmElimCommonBlocks - , Opt_AsmShortcutting - , Opt_OmitYields - , Opt_FunToThunk - , Opt_DictsStrict - , Opt_DmdTxDictSel - , Opt_Loopification - , Opt_CfgBlocklayout - , Opt_WeightlessBlocklayout - , Opt_CprAnal - , Opt_WorkerWrapper - , Opt_SolveConstantDicts - , Opt_CatchBottoms - , Opt_IgnoreAsserts - ] - --- | Used when outputting warnings: if a reason is given, it is --- displayed. If a warning isn't controlled by a flag, this is made --- explicit at the point of use. -data WarnReason - = NoReason - -- | Warning was enabled with the flag - | Reason !WarningFlag - -- | Warning was made an error because of -Werror or -Werror=WarningFlag - | ErrReason !(Maybe WarningFlag) - deriving Show -- | Used to differentiate the scope an include needs to apply to. -- We have to split the include paths to avoid accidentally forcing recursive @@ -834,107 +424,6 @@ addQuoteInclude spec paths = let f = includePathsQuote spec flattenIncludes :: IncludeSpecs -> [String] flattenIncludes specs = includePathsQuote specs ++ includePathsGlobal specs -instance Outputable WarnReason where - ppr = text . show - -instance ToJson WarnReason where - json NoReason = JSNull - json (Reason wf) = JSString (show wf) - json (ErrReason Nothing) = JSString "Opt_WarnIsError" - json (ErrReason (Just wf)) = JSString (show wf) - -data WarningFlag = --- See Note [Updating flag description in the User's Guide] - Opt_WarnDuplicateExports - | Opt_WarnDuplicateConstraints - | Opt_WarnRedundantConstraints - | Opt_WarnHiShadows - | Opt_WarnImplicitPrelude - | Opt_WarnIncompletePatterns - | Opt_WarnIncompleteUniPatterns - | Opt_WarnIncompletePatternsRecUpd - | Opt_WarnOverflowedLiterals - | Opt_WarnEmptyEnumerations - | Opt_WarnMissingFields - | Opt_WarnMissingImportList - | Opt_WarnMissingMethods - | Opt_WarnMissingSignatures - | Opt_WarnMissingLocalSignatures - | Opt_WarnNameShadowing - | Opt_WarnOverlappingPatterns - | Opt_WarnTypeDefaults - | Opt_WarnMonomorphism - | Opt_WarnUnusedTopBinds - | Opt_WarnUnusedLocalBinds - | Opt_WarnUnusedPatternBinds - | Opt_WarnUnusedImports - | Opt_WarnUnusedMatches - | Opt_WarnUnusedTypePatterns - | Opt_WarnUnusedForalls - | Opt_WarnUnusedRecordWildcards - | Opt_WarnRedundantRecordWildcards - | Opt_WarnWarningsDeprecations - | Opt_WarnDeprecatedFlags - | Opt_WarnMissingMonadFailInstances -- since 8.0, has no effect since 8.8 - | Opt_WarnSemigroup -- since 8.0 - | Opt_WarnDodgyExports - | Opt_WarnDodgyImports - | Opt_WarnOrphans - | Opt_WarnAutoOrphans - | Opt_WarnIdentities - | Opt_WarnTabs - | Opt_WarnUnrecognisedPragmas - | Opt_WarnDodgyForeignImports - | Opt_WarnUnusedDoBind - | Opt_WarnWrongDoBind - | Opt_WarnAlternativeLayoutRuleTransitional - | Opt_WarnUnsafe - | Opt_WarnSafe - | Opt_WarnTrustworthySafe - | Opt_WarnMissedSpecs - | Opt_WarnAllMissedSpecs - | Opt_WarnUnsupportedCallingConventions - | Opt_WarnUnsupportedLlvmVersion - | Opt_WarnMissedExtraSharedLib - | Opt_WarnInlineRuleShadowing - | Opt_WarnTypedHoles - | Opt_WarnPartialTypeSignatures - | Opt_WarnMissingExportedSignatures - | Opt_WarnUntickedPromotedConstructors - | Opt_WarnDerivingTypeable - | Opt_WarnDeferredTypeErrors - | Opt_WarnDeferredOutOfScopeVariables - | Opt_WarnNonCanonicalMonadInstances -- since 8.0 - | Opt_WarnNonCanonicalMonadFailInstances -- since 8.0, removed 8.8 - | Opt_WarnNonCanonicalMonoidInstances -- since 8.0 - | Opt_WarnMissingPatternSynonymSignatures -- since 8.0 - | Opt_WarnUnrecognisedWarningFlags -- since 8.0 - | Opt_WarnSimplifiableClassConstraints -- Since 8.2 - | Opt_WarnCPPUndef -- Since 8.2 - | Opt_WarnUnbangedStrictPatterns -- Since 8.2 - | Opt_WarnMissingHomeModules -- Since 8.2 - | Opt_WarnPartialFields -- Since 8.4 - | Opt_WarnMissingExportList - | Opt_WarnInaccessibleCode - | Opt_WarnStarIsType -- Since 8.6 - | Opt_WarnStarBinder -- Since 8.6 - | Opt_WarnImplicitKindVars -- Since 8.6 - | Opt_WarnSpaceAfterBang - | Opt_WarnMissingDerivingStrategies -- Since 8.8 - | Opt_WarnPrepositiveQualifiedModule -- Since TBD - | Opt_WarnUnusedPackages -- Since 8.10 - | Opt_WarnInferredSafeImports -- Since 8.10 - | Opt_WarnMissingSafeHaskellMode -- Since 8.10 - | Opt_WarnCompatUnqualifiedImports -- Since 8.10 - | Opt_WarnDerivingDefaults - deriving (Eq, Show, Enum) - -data Language = Haskell98 | Haskell2010 - deriving (Eq, Enum, Show) - -instance Outputable Language where - ppr = text . show - -- | The various Safe Haskell modes data SafeHaskellMode = Sf_None -- ^ inferred unsafe @@ -1709,143 +1198,6 @@ data RtsOptsEnabled positionIndependent :: DynFlags -> Bool positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags ------------------------------------------------------------------------------ --- Ways - --- The central concept of a "way" is that all objects in a given --- program must be compiled in the same "way". Certain options change --- parameters of the virtual machine, eg. profiling adds an extra word --- to the object header, so profiling objects cannot be linked with --- non-profiling objects. - --- After parsing the command-line options, we determine which "way" we --- are building - this might be a combination way, eg. profiling+threaded. - --- We then find the "build-tag" associated with this way, and this --- becomes the suffix used to find .hi files and libraries used in --- this compilation. - -data Way - = WayCustom String -- for GHC API clients building custom variants - | WayThreaded - | WayDebug - | WayProf - | WayEventLog - | WayDyn - deriving (Eq, Ord, Show) - -allowed_combination :: [Way] -> Bool -allowed_combination way = and [ x `allowedWith` y - | x <- way, y <- way, x < y ] - where - -- Note ordering in these tests: the left argument is - -- <= the right argument, according to the Ord instance - -- on Way above. - - -- dyn is allowed with everything - _ `allowedWith` WayDyn = True - WayDyn `allowedWith` _ = True - - -- debug is allowed with everything - _ `allowedWith` WayDebug = True - WayDebug `allowedWith` _ = True - - (WayCustom {}) `allowedWith` _ = True - WayThreaded `allowedWith` WayProf = True - WayThreaded `allowedWith` WayEventLog = True - WayProf `allowedWith` WayEventLog = True - _ `allowedWith` _ = False - -mkBuildTag :: [Way] -> String -mkBuildTag ways = concat (intersperse "_" (map wayTag ways)) - -wayTag :: Way -> String -wayTag (WayCustom xs) = xs -wayTag WayThreaded = "thr" -wayTag WayDebug = "debug" -wayTag WayDyn = "dyn" -wayTag WayProf = "p" -wayTag WayEventLog = "l" - -wayRTSOnly :: Way -> Bool -wayRTSOnly (WayCustom {}) = False -wayRTSOnly WayThreaded = True -wayRTSOnly WayDebug = True -wayRTSOnly WayDyn = False -wayRTSOnly WayProf = False -wayRTSOnly WayEventLog = True - -wayDesc :: Way -> String -wayDesc (WayCustom xs) = xs -wayDesc WayThreaded = "Threaded" -wayDesc WayDebug = "Debug" -wayDesc WayDyn = "Dynamic" -wayDesc WayProf = "Profiling" -wayDesc WayEventLog = "RTS Event Logging" - --- Turn these flags on when enabling this way -wayGeneralFlags :: Platform -> Way -> [GeneralFlag] -wayGeneralFlags _ (WayCustom {}) = [] -wayGeneralFlags _ WayThreaded = [] -wayGeneralFlags _ WayDebug = [] -wayGeneralFlags _ WayDyn = [Opt_PIC, Opt_ExternalDynamicRefs] - -- We could get away without adding -fPIC when compiling the - -- modules of a program that is to be linked with -dynamic; the - -- program itself does not need to be position-independent, only - -- the libraries need to be. HOWEVER, GHCi links objects into a - -- .so before loading the .so using the system linker. Since only - -- PIC objects can be linked into a .so, we have to compile even - -- modules of the main program with -fPIC when using -dynamic. -wayGeneralFlags _ WayProf = [Opt_SccProfilingOn] -wayGeneralFlags _ WayEventLog = [] - --- Turn these flags off when enabling this way -wayUnsetGeneralFlags :: Platform -> Way -> [GeneralFlag] -wayUnsetGeneralFlags _ (WayCustom {}) = [] -wayUnsetGeneralFlags _ WayThreaded = [] -wayUnsetGeneralFlags _ WayDebug = [] -wayUnsetGeneralFlags _ WayDyn = [-- There's no point splitting - -- when we're going to be dynamically - -- linking. Plus it breaks compilation - -- on OSX x86. - Opt_SplitSections] -wayUnsetGeneralFlags _ WayProf = [] -wayUnsetGeneralFlags _ WayEventLog = [] - -wayOptc :: Platform -> Way -> [String] -wayOptc _ (WayCustom {}) = [] -wayOptc platform WayThreaded = case platformOS platform of - OSOpenBSD -> ["-pthread"] - OSNetBSD -> ["-pthread"] - _ -> [] -wayOptc _ WayDebug = [] -wayOptc _ WayDyn = [] -wayOptc _ WayProf = ["-DPROFILING"] -wayOptc _ WayEventLog = ["-DTRACING"] - -wayOptl :: Platform -> Way -> [String] -wayOptl _ (WayCustom {}) = [] -wayOptl platform WayThreaded = - case platformOS platform of - -- N.B. FreeBSD cc throws a warning if we pass -pthread without - -- actually using any pthread symbols. - OSFreeBSD -> ["-pthread", "-Wno-unused-command-line-argument"] - OSOpenBSD -> ["-pthread"] - OSNetBSD -> ["-pthread"] - _ -> [] -wayOptl _ WayDebug = [] -wayOptl _ WayDyn = [] -wayOptl _ WayProf = [] -wayOptl _ WayEventLog = [] - -wayOptP :: Platform -> Way -> [String] -wayOptP _ (WayCustom {}) = [] -wayOptP _ WayThreaded = [] -wayOptP _ WayDebug = [] -wayOptP _ WayDyn = [] -wayOptP _ WayProf = ["-DPROFILING"] -wayOptP _ WayEventLog = ["-DTRACING"] - whenGeneratingDynamicToo :: MonadIO m => DynFlags -> m () -> m () whenGeneratingDynamicToo dflags f = ifGeneratingDynamicToo dflags f (return ()) @@ -2038,7 +1390,7 @@ defaultDynFlags mySettings llvmConfig = pkgDatabase = Nothing, pkgState = emptyPackageState, ways = defaultWays mySettings, - buildTag = mkBuildTag (defaultWays mySettings), + buildTag = waysTag (defaultWays mySettings), splitInfo = Nothing, ghcNameVersion = sGhcNameVersion mySettings, @@ -2149,21 +1501,15 @@ defaultWays settings = if pc_DYNAMIC_BY_DEFAULT (sPlatformConstants settings) then [WayDyn] else [] -interpWays :: [Way] -interpWays - | dynamicGhc = [WayDyn] - | rtsIsProfiled = [WayProf] - | otherwise = [] - interpreterProfiled :: DynFlags -> Bool interpreterProfiled dflags | gopt Opt_ExternalInterpreter dflags = gopt Opt_SccProfilingOn dflags - | otherwise = rtsIsProfiled + | otherwise = hostIsProfiled interpreterDynamic :: DynFlags -> Bool interpreterDynamic dflags | gopt Opt_ExternalInterpreter dflags = WayDyn `elem` ways dflags - | otherwise = dynamicGhc + | otherwise = hostIsDynamic -------------------------------------------------------------------------- -- @@ -2857,7 +2203,7 @@ updateWays dflags = let theWays = sort $ nub $ ways dflags in dflags { ways = theWays, - buildTag = mkBuildTag (filter (not . wayRTSOnly) theWays) + buildTag = waysTag (filter (not . wayRTSOnly) theWays) } -- | Check (and potentially disable) any extensions that aren't allowed @@ -4980,21 +4326,6 @@ glasgowExtsFlags = [ , LangExt.UnicodeSyntax , LangExt.UnliftedFFITypes ] -foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt - --- | Was the runtime system built with profiling enabled? -rtsIsProfiled :: Bool -rtsIsProfiled = unsafeDupablePerformIO rtsIsProfiledIO /= 0 - --- Consult the RTS to find whether GHC itself has been built with --- dynamic linking. This can't be statically known at compile-time, --- because we build both the static and dynamic versions together with --- -dynamic-too. -foreign import ccall unsafe "rts_isDynamic" rtsIsDynamicIO :: IO CInt - -dynamicGhc :: Bool -dynamicGhc = unsafeDupablePerformIO rtsIsDynamicIO /= 0 - setWarnSafe :: Bool -> DynP () setWarnSafe True = getCurLoc >>= \l -> upd (\d -> d { warnSafeOnLoc = l }) setWarnSafe False = return () @@ -5587,9 +4918,9 @@ compilerInfo dflags -- Whether or not GHC compiles libraries as dynamic by default ("Dynamic by default", showBool $ dYNAMIC_BY_DEFAULT dflags), -- Whether or not GHC was compiled using -dynamic - ("GHC Dynamic", showBool dynamicGhc), + ("GHC Dynamic", showBool hostIsDynamic), -- Whether or not GHC was compiled using -prof - ("GHC Profiled", showBool rtsIsProfiled), + ("GHC Profiled", showBool hostIsProfiled), ("Debug on", showBool debugIsOn), ("LibDir", topDir dflags), -- The path of the global package database used by GHC @@ -5710,7 +5041,7 @@ makeDynFlagsConsistent dflags | LinkInMemory <- ghcLink dflags , not (gopt Opt_ExternalInterpreter dflags) - , rtsIsProfiled + , hostIsProfiled , isObjectTarget (hscTarget dflags) , WayProf `notElem` ways dflags = loop dflags{ways = WayProf : ways dflags} diff --git a/compiler/GHC/Driver/Session.hs-boot b/compiler/GHC/Driver/Session.hs-boot index c61d6b5297..23458ee1eb 100644 --- a/compiler/GHC/Driver/Session.hs-boot +++ b/compiler/GHC/Driver/Session.hs-boot @@ -5,8 +5,6 @@ import GHC.Platform import {-# SOURCE #-} Outputable data DynFlags -data DumpFlag -data GeneralFlag targetPlatform :: DynFlags -> Platform pprUserLength :: DynFlags -> Int diff --git a/compiler/GHC/Driver/Ways.hs b/compiler/GHC/Driver/Ways.hs new file mode 100644 index 0000000000..b295cc1a0d --- /dev/null +++ b/compiler/GHC/Driver/Ways.hs @@ -0,0 +1,191 @@ +-- | Ways +-- +-- The central concept of a "way" is that all objects in a given +-- program must be compiled in the same "way". Certain options change +-- parameters of the virtual machine, eg. profiling adds an extra word +-- to the object header, so profiling objects cannot be linked with +-- non-profiling objects. +-- +-- After parsing the command-line options, we determine which "way" we +-- are building - this might be a combination way, eg. profiling+threaded. +-- +-- There are two kinds of ways: +-- - RTS only: only affect the runtime system (RTS) and don't affect code +-- generation (e.g. threaded, debug) +-- - Full ways: affect code generation and the RTS (e.g. profiling, dynamic +-- linking) +-- +-- We then find the "build-tag" associated with this way, and this +-- becomes the suffix used to find .hi files and libraries used in +-- this compilation. +module GHC.Driver.Ways + ( Way(..) + , allowed_combination + , wayGeneralFlags + , wayUnsetGeneralFlags + , wayOptc + , wayOptl + , wayOptP + , wayDesc + , wayRTSOnly + , wayTag + , waysTag + -- * Host GHC ways + , hostFullWays + , hostIsProfiled + , hostIsDynamic + ) +where + +import GhcPrelude +import GHC.Platform +import GHC.Driver.Flags +import Util (nubSort) + +import qualified Data.Set as Set +import Data.List (intersperse) +import System.IO.Unsafe ( unsafeDupablePerformIO ) + +-- | A way +-- +-- Don't change the constructor order as it us used by `waysTag` to create a +-- unique tag (e.g. thr_debug_p) which is expected by other tools (e.g. Cabal). +data Way + = WayCustom String -- ^ for GHC API clients building custom variants + | WayThreaded -- ^ (RTS only) Multithreaded runtime system + | WayDebug -- ^ Debugging, enable trace messages and extra checks + | WayProf -- ^ Profiling, enable cost-centre stacks and profiling reports + | WayEventLog -- ^ (RTS only) enable event logging + | WayDyn -- ^ Dynamic linking + deriving (Eq, Ord, Show) + + +-- | Check if a combination of ways is allowed +allowed_combination :: [Way] -> Bool +allowed_combination ways = not disallowed + where + s = Set.fromList ways + disallowed = or [ Set.member s x && Set.member s y + | (x,y) <- couples + ] + -- List of disallowed couples of ways + couples = [] -- we don't have any disallowed combination of ways nowadays + +-- | Unique build-tag associated to a list of ways +waysTag :: [Way] -> String +waysTag = concat . intersperse "_" . map wayTag . nubSort + +-- | Unique build-tag associated to a way +wayTag :: Way -> String +wayTag (WayCustom xs) = xs +wayTag WayThreaded = "thr" +wayTag WayDebug = "debug" +wayTag WayDyn = "dyn" +wayTag WayProf = "p" +wayTag WayEventLog = "l" + +-- | Return true for ways that only impact the RTS, not the generated code +wayRTSOnly :: Way -> Bool +wayRTSOnly (WayCustom {}) = False +wayRTSOnly WayDyn = False +wayRTSOnly WayProf = False +wayRTSOnly WayThreaded = True +wayRTSOnly WayDebug = True +wayRTSOnly WayEventLog = True + +wayDesc :: Way -> String +wayDesc (WayCustom xs) = xs +wayDesc WayThreaded = "Threaded" +wayDesc WayDebug = "Debug" +wayDesc WayDyn = "Dynamic" +wayDesc WayProf = "Profiling" +wayDesc WayEventLog = "RTS Event Logging" + +-- | Turn these flags on when enabling this way +wayGeneralFlags :: Platform -> Way -> [GeneralFlag] +wayGeneralFlags _ (WayCustom {}) = [] +wayGeneralFlags _ WayThreaded = [] +wayGeneralFlags _ WayDebug = [] +wayGeneralFlags _ WayDyn = [Opt_PIC, Opt_ExternalDynamicRefs] + -- We could get away without adding -fPIC when compiling the + -- modules of a program that is to be linked with -dynamic; the + -- program itself does not need to be position-independent, only + -- the libraries need to be. HOWEVER, GHCi links objects into a + -- .so before loading the .so using the system linker. Since only + -- PIC objects can be linked into a .so, we have to compile even + -- modules of the main program with -fPIC when using -dynamic. +wayGeneralFlags _ WayProf = [Opt_SccProfilingOn] +wayGeneralFlags _ WayEventLog = [] + +-- | Turn these flags off when enabling this way +wayUnsetGeneralFlags :: Platform -> Way -> [GeneralFlag] +wayUnsetGeneralFlags _ (WayCustom {}) = [] +wayUnsetGeneralFlags _ WayThreaded = [] +wayUnsetGeneralFlags _ WayDebug = [] +wayUnsetGeneralFlags _ WayDyn = [Opt_SplitSections] + -- There's no point splitting when we're going to be dynamically linking. + -- Plus it breaks compilation on OSX x86. +wayUnsetGeneralFlags _ WayProf = [] +wayUnsetGeneralFlags _ WayEventLog = [] + +-- | Pass these options to the C compiler when enabling this way +wayOptc :: Platform -> Way -> [String] +wayOptc _ (WayCustom {}) = [] +wayOptc platform WayThreaded = case platformOS platform of + OSOpenBSD -> ["-pthread"] + OSNetBSD -> ["-pthread"] + _ -> [] +wayOptc _ WayDebug = [] +wayOptc _ WayDyn = [] +wayOptc _ WayProf = ["-DPROFILING"] +wayOptc _ WayEventLog = ["-DTRACING"] + +-- | Pass these options to linker when enabling this way +wayOptl :: Platform -> Way -> [String] +wayOptl _ (WayCustom {}) = [] +wayOptl platform WayThreaded = + case platformOS platform of + -- N.B. FreeBSD cc throws a warning if we pass -pthread without + -- actually using any pthread symbols. + OSFreeBSD -> ["-pthread", "-Wno-unused-command-line-argument"] + OSOpenBSD -> ["-pthread"] + OSNetBSD -> ["-pthread"] + _ -> [] +wayOptl _ WayDebug = [] +wayOptl _ WayDyn = [] +wayOptl _ WayProf = [] +wayOptl _ WayEventLog = [] + +-- | Pass these options to the preprocessor when enabling this way +wayOptP :: Platform -> Way -> [String] +wayOptP _ (WayCustom {}) = [] +wayOptP _ WayThreaded = [] +wayOptP _ WayDebug = [] +wayOptP _ WayDyn = [] +wayOptP _ WayProf = ["-DPROFILING"] +wayOptP _ WayEventLog = ["-DTRACING"] + + +-- | Consult the RTS to find whether it has been built with profiling enabled. +hostIsProfiled :: Bool +hostIsProfiled = unsafeDupablePerformIO rtsIsProfiledIO /= 0 + +foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO Int + +-- | Consult the RTS to find whether GHC itself has been built with +-- dynamic linking. This can't be statically known at compile-time, +-- because we build both the static and dynamic versions together with +-- -dynamic-too. +hostIsDynamic :: Bool +hostIsDynamic = unsafeDupablePerformIO rtsIsDynamicIO /= 0 + +foreign import ccall unsafe "rts_isDynamic" rtsIsDynamicIO :: IO Int + +-- | Return host "full" ways (i.e. ways that have an impact on the compilation, +-- not RTS only ways). These ways must be used when compiling codes targeting +-- the internal interpreter. +hostFullWays :: [Way] +hostFullWays = mconcat + [ if hostIsDynamic then [WayDyn] else [] + , if hostIsProfiled then [WayProf] else [] + ] diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs index 46e4c9fbd7..0c2546af56 100644 --- a/compiler/GHC/Runtime/Linker.hs +++ b/compiler/GHC/Runtime/Linker.hs @@ -43,6 +43,7 @@ import GHC.Driver.Packages as Packages import GHC.Driver.Phases import GHC.Driver.Finder import GHC.Driver.Types +import GHC.Driver.Ways import Name import NameEnv import Module @@ -492,7 +493,7 @@ preloadLib hsc_env lib_paths framework_paths pls lib_spec = do preload_statics _paths names = do b <- or <$> mapM doesFileExist names if not b then return (False, pls) - else if dynamicGhc + else if hostIsDynamic then do pls1 <- dynLoadObjs hsc_env pls names return (True, pls1) else do mapM_ (loadObj hsc_env) names @@ -501,7 +502,7 @@ preloadLib hsc_env lib_paths framework_paths pls lib_spec = do preload_static_archive _paths name = do b <- doesFileExist name if not b then return False - else do if dynamicGhc + else do if hostIsDynamic then throwGhcExceptionIO $ CmdLineError dynamic_msg else loadArchive hsc_env name @@ -582,17 +583,17 @@ checkNonStdWay hsc_env srcspan -- they were built. If they were built for a non-std way, then -- we will use the appropriate variant of the iserv binary to load them. - | interpWays == haskellWays = return Nothing + | hostFullWays == targetFullWays = return Nothing -- Only if we are compiling with the same ways as GHC is built -- with, can we dynamically load those object files. (see #3604) - | objectSuf (hsc_dflags hsc_env) == normalObjectSuffix && not (null haskellWays) + | objectSuf (hsc_dflags hsc_env) == normalObjectSuffix && not (null targetFullWays) = failNonStd (hsc_dflags hsc_env) srcspan - | otherwise = return (Just (interpTag ++ "o")) + | otherwise = return (Just (hostWayTag ++ "o")) where - haskellWays = filter (not . wayRTSOnly) (ways (hsc_dflags hsc_env)) - interpTag = case mkBuildTag interpWays of + targetFullWays = filter (not . wayRTSOnly) (ways (hsc_dflags hsc_env)) + hostWayTag = case waysTag hostFullWays of "" -> "" tag -> tag ++ "_" @@ -614,8 +615,8 @@ failNonStd dflags srcspan = dieWith dflags srcspan $ | WayProf `elem` ways dflags = text "-prof" | otherwise = text "normal" ghciWay - | dynamicGhc = text "with -dynamic" - | rtsIsProfiled = text "with -prof" + | hostIsDynamic = text "with -dynamic" + | hostIsProfiled = text "with -prof" | otherwise = text "the normal way" getLinkDeps :: HscEnv -> HomePackageTable @@ -949,7 +950,7 @@ dynLoadObjs hsc_env pls@PersistentLinkerState{..} objs = do -- the vanilla dynamic libraries, so we set the -- ways / build tag to be just WayDyn. ways = [WayDyn], - buildTag = mkBuildTag [WayDyn], + buildTag = waysTag [WayDyn], outputFile = Just soFile } -- link all "loaded packages" so symbols in those can be resolved @@ -1141,7 +1142,7 @@ unload_wkr hsc_env keep_linkables pls@PersistentLinkerState{..} = do where unloadObjs :: Linkable -> IO () unloadObjs lnk - | dynamicGhc = return () + | hostIsDynamic = return () -- We don't do any cleanup when linking objects with the -- dynamic linker. Doing so introduces extra complexity for -- not much benefit. |