diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..bfae447 --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +/ghc-9.10.0.20240313-src.tar.xz diff --git a/9604.patch b/9604.patch new file mode 100644 index 0000000..9abc884 --- /dev/null +++ b/9604.patch @@ -0,0 +1,1326 @@ +From 40c9da19decb68e1bf4be6fef7b0592c19a8cacd Mon Sep 17 00:00:00 2001 +From: Matthew Pickering +Date: Tue, 13 Dec 2022 12:30:36 +0000 +Subject: [PATCH] Add flag to control whether self-recompilation information is + written to interface + +This patch adds the flag -fwrite-self-recomp-info which controls whether +interface files contain the information necessary to answer the +question: + + Do I need to recompile myself or is this current interface file + suitable? + +Why? Most packages are only built once either by a distribution or cabal +and then placed into an immutable store, after which we will never ask +this question. Therefore we can derive two benefits from omitting this +information. + +* Primary motivation: It vastly reduces the surface area for creating + non-deterministic interface files. See issue #10424 which motivated a + proper fix to that issue. Distributions have long contained versions + of GHC which just have broken self-recompilation checking (in order to + get deterministic interface files). + +* Secondary motivation: This reduces the size of interface files + slightly.. the `mi_usages` field can be quite big but probably this + isn't such a great benefit. + +* Third motivation: Conceptually clarity about which parts of an + interface file are used in order to **communicate** with subsequent + packages about the **interface** for a module. And which parts are + used to self-communicate during recompilation checking. + +In addition to this, the change alerted me to the incorrect +implemenation of the reifyModule function. See #8489 for more discussion +about how to fix this if anyone was so inclined. For now I just added a +warning `-Wreify-module-missing-info` which triggers if the module you +are trying to reify doesn't have a suitable interface. Interfaces which +are unsuitable include: + + * The GHC.Prim interface, which is a fake interface + * Interfaces compiled with -fno-write-self-recomp-info + +The main tracking issue is #22188 but fixes issues such as #10424 in a +proper way. +--- + compiler/GHC/Driver/Flags.hs | 6 +- + compiler/GHC/Driver/Session.hs | 8 +- + compiler/GHC/HsToCore.hs | 23 +- + compiler/GHC/Iface/Binary.hs | 10 +- + compiler/GHC/Iface/Load.hs | 22 +- + compiler/GHC/Iface/Make.hs | 59 ++-- + compiler/GHC/Iface/Recomp.hs | 77 +++--- + compiler/GHC/Tc/Errors/Ppr.hs | 6 + + compiler/GHC/Tc/Errors/Types.hs | 6 + + compiler/GHC/Tc/Gen/Splice.hs | 21 +- + compiler/GHC/Types/Error/Codes.hs | 2 + + compiler/GHC/Unit/Module/ModGuts.hs | 2 +- + compiler/GHC/Unit/Module/ModIface.hs | 253 +++++++++++++----- + docs/users_guide/phases.rst | 18 ++ + docs/users_guide/using-warnings.rst | 15 ++ + .../should_compile/th/annth_compunits.stderr | 11 + + .../should_compile/th/annth_make.stderr | 11 + + testsuite/tests/driver/self-recomp/Makefile | 38 +++ + .../tests/driver/self-recomp/SelfRecomp01.hs | 2 + + .../tests/driver/self-recomp/SelfRecomp02.hs | 6 + + .../tests/driver/self-recomp/SelfRecomp03.hs | 2 + + .../tests/driver/self-recomp/SelfRecomp04.hs | 1 + + .../driver/self-recomp/SelfRecomp04.stdout | 2 + + testsuite/tests/driver/self-recomp/all.T | 4 + + 24 files changed, 449 insertions(+), 156 deletions(-) + create mode 100644 testsuite/tests/annotations/should_compile/th/annth_compunits.stderr + create mode 100644 testsuite/tests/annotations/should_compile/th/annth_make.stderr + create mode 100644 testsuite/tests/driver/self-recomp/Makefile + create mode 100644 testsuite/tests/driver/self-recomp/SelfRecomp01.hs + create mode 100644 testsuite/tests/driver/self-recomp/SelfRecomp02.hs + create mode 100644 testsuite/tests/driver/self-recomp/SelfRecomp03.hs + create mode 100644 testsuite/tests/driver/self-recomp/SelfRecomp04.hs + create mode 100644 testsuite/tests/driver/self-recomp/SelfRecomp04.stdout + create mode 100644 testsuite/tests/driver/self-recomp/all.T + +diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs +index f45397d8872..fbae3c7a242 100644 +--- a/compiler/GHC/Driver/Flags.hs ++++ b/compiler/GHC/Driver/Flags.hs +@@ -302,6 +302,7 @@ data GeneralFlag + | Opt_OmitInterfacePragmas + | Opt_ExposeAllUnfoldings + | Opt_WriteInterface -- forces .hi files to be written even with -fno-code ++ | Opt_WriteSelfRecompInfo + | Opt_WriteHie -- generate .hie files + + -- profiling opts +@@ -624,6 +625,7 @@ data WarningFlag = + | Opt_WarnGADTMonoLocalBinds -- Since 9.4 + | Opt_WarnTypeEqualityOutOfScope -- Since 9.4 + | Opt_WarnTypeEqualityRequiresOperators -- Since 9.4 ++ | Opt_WarnReifyModuleMissingInfo -- Since 9.6 + deriving (Eq, Ord, Show, Enum) + + -- | Return the names of a WarningFlag +@@ -729,6 +731,7 @@ warnFlagNames wflag = case wflag of + Opt_WarnGADTMonoLocalBinds -> "gadt-mono-local-binds" :| [] + Opt_WarnTypeEqualityOutOfScope -> "type-equality-out-of-scope" :| [] + Opt_WarnTypeEqualityRequiresOperators -> "type-equality-requires-operators" :| [] ++ Opt_WarnReifyModuleMissingInfo -> "reify-module-missing-info" :| [] + + -- ----------------------------------------------------------------------------- + -- Standard sets of warning options +@@ -824,7 +827,8 @@ standardWarnings -- see Note [Documenting warning flags] + Opt_WarnForallIdentifier, + Opt_WarnUnicodeBidirectionalFormatCharacters, + Opt_WarnGADTMonoLocalBinds, +- Opt_WarnTypeEqualityRequiresOperators ++ Opt_WarnTypeEqualityRequiresOperators, ++ Opt_WarnReifyModuleMissingInfo + ] + + -- | Things you get with -W +diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs +index 831267e2bf6..0dd79006999 100644 +--- a/compiler/GHC/Driver/Session.hs ++++ b/compiler/GHC/Driver/Session.hs +@@ -3327,7 +3327,8 @@ wWarningFlagsDeps = mconcat [ + warnSpec Opt_WarnUnicodeBidirectionalFormatCharacters, + warnSpec Opt_WarnGADTMonoLocalBinds, + warnSpec Opt_WarnTypeEqualityOutOfScope, +- warnSpec Opt_WarnTypeEqualityRequiresOperators ++ warnSpec Opt_WarnTypeEqualityRequiresOperators, ++ warnSpec Opt_WarnReifyModuleMissingInfo + ] + + -- | These @-\@ flags can all be reversed with @-no-\@ +@@ -3486,6 +3487,7 @@ fFlagsDeps = [ + flagSpec "use-rpaths" Opt_RPath, + flagSpec "write-interface" Opt_WriteInterface, + flagSpec "write-if-simplified-core" Opt_WriteIfSimplifiedCore, ++ flagSpec "write-self-recomp-info" Opt_WriteSelfRecompInfo, + flagSpec "write-ide-info" Opt_WriteHie, + flagSpec "unbox-small-strict-fields" Opt_UnboxSmallStrictFields, + flagSpec "unbox-strict-fields" Opt_UnboxStrictFields, +@@ -3809,7 +3811,9 @@ defaultFlags settings + Opt_DumpWithWays, + Opt_CompactUnwind, + Opt_ShowErrorContext, +- Opt_SuppressStgReps ++ Opt_SuppressStgReps, ++ Opt_WriteSelfRecompInfo ++ + ] + + ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] +diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs +index 3c6ec710790..dd578475864 100644 +--- a/compiler/GHC/HsToCore.hs ++++ b/compiler/GHC/HsToCore.hs +@@ -22,14 +22,12 @@ import GHC.Driver.Session + import GHC.Driver.Config + import GHC.Driver.Config.Core.Lint ( endPassHscEnvIO ) + import GHC.Driver.Config.HsToCore.Ticks +-import GHC.Driver.Config.HsToCore.Usage + import GHC.Driver.Env + import GHC.Driver.Backend + import GHC.Driver.Plugins + + import GHC.Hs + +-import GHC.HsToCore.Usage + import GHC.HsToCore.Monad + import GHC.HsToCore.Errors.Types + import GHC.HsToCore.Expr +@@ -41,7 +39,7 @@ import GHC.HsToCore.Coverage + import GHC.HsToCore.Docs + + import GHC.Tc.Types +-import GHC.Tc.Utils.Monad ( finalSafeMode, fixSafeInstances, initIfaceLoad ) ++import GHC.Tc.Utils.Monad ( finalSafeMode, fixSafeInstances ) + import GHC.Tc.Module ( runTcInteractive ) + + import GHC.Core.Type +@@ -98,6 +96,7 @@ import GHC.Unit.Module.Deps + import Data.List (partition) + import Data.IORef + import Data.Traversable (for) ++import GHC.Iface.Make (mkRecompUsageInfo) + + {- + ************************************************************************ +@@ -125,12 +124,10 @@ deSugar hsc_env + tcg_fix_env = fix_env, + tcg_inst_env = inst_env, + tcg_fam_inst_env = fam_inst_env, +- tcg_merged = merged, + tcg_warns = warns, + tcg_anns = anns, + tcg_binds = binds, + tcg_imp_specs = imp_specs, +- tcg_dependent_files = dependent_files, + tcg_ev_binds = ev_binds, + tcg_th_foreign_files = th_foreign_files_var, + tcg_fords = fords, +@@ -224,8 +221,7 @@ deSugar hsc_env + + ; endPassHscEnvIO hsc_env name_ppr_ctx CoreDesugarOpt ds_binds ds_rules_for_imps + +- ; let used_names = mkUsedNames tcg_env +- pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env)) ++ ; let pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env)) + home_unit = hsc_home_unit hsc_env + ; let deps = mkDependencies home_unit + (tcg_mod tcg_env) +@@ -233,17 +229,10 @@ deSugar hsc_env + (map mi_module pluginModules) + + ; used_th <- readIORef tc_splice_used +- ; dep_files <- readIORef dependent_files + ; safe_mode <- finalSafeMode dflags tcg_env +- ; (needed_mods, needed_pkgs) <- readIORef (tcg_th_needed_deps tcg_env) +- +- ; let uc = initUsageConfig hsc_env +- ; let plugins = hsc_plugins hsc_env +- ; let fc = hsc_FC hsc_env +- ; let unit_env = hsc_unit_env hsc_env +- ; usages <- initIfaceLoad hsc_env $ +- mkUsageInfo uc plugins fc unit_env mod (imp_mods imports) used_names +- dep_files merged needed_mods needed_pkgs ++ ++ ; usages <- mkRecompUsageInfo hsc_env tcg_env ++ + -- id_mod /= mod when we are processing an hsig, but hsigs + -- never desugared and compiled (there's no code!) + -- Consequently, this should hold for any ModGuts that make +diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs +index 78045aa782f..48dc54fa8ba 100644 +--- a/compiler/GHC/Iface/Binary.hs ++++ b/compiler/GHC/Iface/Binary.hs +@@ -45,7 +45,6 @@ import GHC.Types.Name.Cache + import GHC.Types.SrcLoc + import GHC.Platform + import GHC.Settings.Constants +-import GHC.Utils.Fingerprint + + import Data.Array + import Data.Array.IO +@@ -75,7 +74,7 @@ readBinIfaceHeader + -> CheckHiWay + -> TraceBinIFace + -> FilePath +- -> IO (Fingerprint, BinHandle) ++ -> IO BinHandle + readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do + let platform = profilePlatform profile + +@@ -117,8 +116,7 @@ readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do + when (checkHiWay == CheckHiWay) $ + errorOnMismatch "mismatched interface file profile tag" tag check_tag + +- src_hash <- get bh +- pure (src_hash, bh) ++ pure bh + + -- | Read an interface file. + readBinIface +@@ -129,7 +127,7 @@ readBinIface + -> FilePath + -> IO ModIface + readBinIface profile name_cache checkHiWay traceBinIface hi_path = do +- (src_hash, bh) <- readBinIfaceHeader profile name_cache checkHiWay traceBinIface hi_path ++ bh <- readBinIfaceHeader profile name_cache checkHiWay traceBinIface hi_path + + extFields_p <- get bh + +@@ -140,7 +138,6 @@ readBinIface profile name_cache checkHiWay traceBinIface hi_path = do + + return mod_iface + { mi_ext_fields = extFields +- , mi_src_hash = src_hash + } + + -- | This performs a get action after reading the dictionary and symbol +@@ -182,7 +179,6 @@ writeBinIface profile traceBinIface hi_path mod_iface = do + put_ bh (show hiVersion) + let tag = profileBuildTag profile + put_ bh tag +- put_ bh (mi_src_hash mod_iface) + + extFields_p_p <- tellBin bh + put_ bh extFields_p_p +diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs +index bf7ae8e0059..400782628be 100644 +--- a/compiler/GHC/Iface/Load.hs ++++ b/compiler/GHC/Iface/Load.hs +@@ -1105,28 +1105,31 @@ pprModIfaceSimple unit_state iface = + -- The UnitState is used to pretty-print units + pprModIface :: UnitState -> ModIface -> SDoc + pprModIface unit_state iface@ModIface{ mi_final_exts = exts } +- = vcat [ text "interface" ++ = vcat $ [ text "interface" + <+> ppr (mi_module iface) <+> pp_hsc_src (mi_hsc_src iface) ++ <+> whenIsSelfRecomp (text "[self-recomp]") + <+> (if mi_orphan exts then text "[orphan module]" else Outputable.empty) + <+> (if mi_finsts exts then text "[family instance module]" else Outputable.empty) + <+> (if mi_hpc iface then text "[hpc]" else Outputable.empty) + <+> integer hiVersion +- , nest 2 (text "interface hash:" <+> ppr (mi_iface_hash exts)) + , nest 2 (text "ABI hash:" <+> ppr (mi_mod_hash exts)) + , nest 2 (text "export-list hash:" <+> ppr (mi_exp_hash exts)) ++ , whenIsSelfRecomp $ vcat ++ [ nest 2 (text "interface hash:" <+> ppr (mi_iface_hash exts)) ++ , nest 2 (text "flag hash:" <+> ppr (mi_flag_hash exts)) ++ , nest 2 (text "opt_hash:" <+> ppr (mi_opt_hash exts)) ++ , nest 2 (text "hpc_hash:" <+> ppr (mi_hpc_hash exts)) ++ , nest 2 (text "plugin_hash:" <+> ppr (mi_plugin_hash exts)) ++ ] + , nest 2 (text "orphan hash:" <+> ppr (mi_orphan_hash exts)) +- , nest 2 (text "flag hash:" <+> ppr (mi_flag_hash exts)) +- , nest 2 (text "opt_hash:" <+> ppr (mi_opt_hash exts)) +- , nest 2 (text "hpc_hash:" <+> ppr (mi_hpc_hash exts)) +- , nest 2 (text "plugin_hash:" <+> ppr (mi_plugin_hash exts)) +- , nest 2 (text "src_hash:" <+> ppr (mi_src_hash iface)) + , nest 2 (text "sig of:" <+> ppr (mi_sig_of iface)) + , nest 2 (text "used TH splices:" <+> ppr (mi_used_th iface)) ++ , whenIsSelfRecomp $ nest 2 (text "src_hash:" <+> ppr (mi_src_hash iface)) + , nest 2 (text "where") + , text "exports:" + , nest 2 (vcat (map pprExport (mi_exports iface))) + , pprDeps unit_state (mi_deps iface) +- , vcat (map pprUsage (mi_usages iface)) ++ , whenIsSelfRecomp $ vcat (map pprUsage (mi_usages iface)) + , vcat (map pprIfaceAnnotation (mi_anns iface)) + , pprFixities (mi_fixities iface) + , vcat [ppr ver $$ nest 2 (ppr decl) | (ver,decl) <- mi_decls iface] +@@ -1145,6 +1148,9 @@ pprModIface unit_state iface@ModIface{ mi_final_exts = exts } + , text "extensible fields:" $$ nest 2 (pprExtensibleFields (mi_ext_fields iface)) + ] + where ++ whenIsSelfRecomp action = ++ if (isSelfRecompilationInterface iface) then action else empty ++ + pp_hsc_src HsBootFile = text "[boot]" + pp_hsc_src HsigFile = text "[hsig]" + pp_hsc_src HsSrcFile = Outputable.empty +diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs +index ac55220cbfb..f55e943dbe1 100644 +--- a/compiler/GHC/Iface/Make.hs ++++ b/compiler/GHC/Iface/Make.hs +@@ -13,6 +13,7 @@ module GHC.Iface.Make + ( mkPartialIface + , mkFullIface + , mkIfaceTc ++ , mkRecompUsageInfo + , mkIfaceExports + , coAxiomToIfaceDecl + , tyThingToIfaceDecl -- Converting things to their Iface equivalents +@@ -203,14 +204,11 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary mb_program + tcg_imports = imports, + tcg_rdr_env = rdr_env, + tcg_fix_env = fix_env, +- tcg_merged = merged, + tcg_warns = warns, + tcg_hpc = other_hpc_info, +- tcg_th_splice_used = tc_splice_used, +- tcg_dependent_files = dependent_files ++ tcg_th_splice_used = tc_splice_used + } + = do +- let used_names = mkUsedNames tc_result + let pluginModules = map lpModule (loadedPlugins (hsc_plugins hsc_env)) + let home_unit = hsc_home_unit hsc_env + let deps = mkDependencies home_unit +@@ -219,47 +217,58 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary mb_program + (map mi_module pluginModules) + let hpc_info = emptyHpcInfo other_hpc_info + used_th <- readIORef tc_splice_used +- dep_files <- (readIORef dependent_files) +- (needed_links, needed_pkgs) <- readIORef (tcg_th_needed_deps tc_result) +- let uc = initUsageConfig hsc_env +- plugins = hsc_plugins hsc_env +- fc = hsc_FC hsc_env +- unit_env = hsc_unit_env hsc_env +- -- Do NOT use semantic module here; this_mod in mkUsageInfo +- -- is used solely to decide if we should record a dependency +- -- or not. When we instantiate a signature, the semantic +- -- module is something we want to record dependencies for, +- -- but if you pass that in here, we'll decide it's the local +- -- module and does not need to be recorded as a dependency. +- -- See Note [Identity versus semantic module] +- usages <- initIfaceLoad hsc_env $ mkUsageInfo uc plugins fc unit_env this_mod (imp_mods imports) used_names +- dep_files merged needed_links needed_pkgs + ++ usage <- mkRecompUsageInfo hsc_env tc_result + docs <- extractDocs (ms_hspp_opts mod_summary) tc_result + + let partial_iface = mkIface_ hsc_env + this_mod (fromMaybe [] mb_program) hsc_src + used_th deps rdr_env + fix_env warns hpc_info +- (imp_trust_own_pkg imports) safe_mode usages ++ (imp_trust_own_pkg imports) safe_mode usage + docs mod_summary + mod_details + + mkFullIface hsc_env partial_iface Nothing Nothing + ++mkRecompUsageInfo :: HscEnv -> TcGblEnv -> IO (Maybe [Usage]) ++mkRecompUsageInfo hsc_env tc_result = do ++ let dflags = hsc_dflags hsc_env ++ if not (gopt Opt_WriteSelfRecompInfo dflags) ++ then return Nothing ++ else do ++ let used_names = mkUsedNames tc_result ++ dep_files <- (readIORef (tcg_dependent_files tc_result)) ++ (needed_links, needed_pkgs) <- readIORef (tcg_th_needed_deps tc_result) ++ let uc = initUsageConfig hsc_env ++ plugins = hsc_plugins hsc_env ++ fc = hsc_FC hsc_env ++ unit_env = hsc_unit_env hsc_env ++ ++ -- Do NOT use semantic module here; this_mod in mkUsageInfo ++ -- is used solely to decide if we should record a dependency ++ -- or not. When we instantiate a signature, the semantic ++ -- module is something we want to record dependencies for, ++ -- but if you pass that in here, we'll decide it's the local ++ -- module and does not need to be recorded as a dependency. ++ -- See Note [Identity versus semantic module] ++ usages <- initIfaceLoad hsc_env $ mkUsageInfo uc plugins fc unit_env (tcg_mod tc_result) (imp_mods (tcg_imports tc_result)) used_names ++ dep_files (tcg_merged tc_result) needed_links needed_pkgs ++ return (Just usages) ++ + mkIface_ :: HscEnv -> Module -> CoreProgram -> HscSource + -> Bool -> Dependencies -> GlobalRdrEnv + -> NameEnv FixItem -> Warnings GhcRn -> HpcInfo + -> Bool + -> SafeHaskellMode +- -> [Usage] ++ -> Maybe [Usage] + -> Maybe Docs + -> ModSummary + -> ModDetails + -> PartialModIface + mkIface_ hsc_env + this_mod core_prog hsc_src used_th deps rdr_env fix_env src_warns +- hpc_info pkg_trust_req safe_mode usages ++ hpc_info pkg_trust_req safe_mode musages + docs mod_summary + ModDetails{ md_insts = insts, + md_fam_insts = fam_insts, +@@ -307,6 +316,9 @@ mkIface_ hsc_env + trust_info = setSafeMode safe_mode + annotations = map mkIfaceAnnotation anns + icomplete_matches = map mkIfaceCompleteMatch complete_matches ++ self_recomp = case musages of ++ Nothing -> NoSelfRecomp ++ Just usages -> ModIfaceSelfRecomp (ms_hs_hash mod_summary) usages + + ModIface { + mi_module = this_mod, +@@ -317,7 +329,6 @@ mkIface_ hsc_env + else Just semantic_mod, + mi_hsc_src = hsc_src, + mi_deps = deps, +- mi_usages = usages, + mi_exports = mkIfaceExports exports, + + -- Sort these lexicographically, so that +@@ -340,7 +351,7 @@ mkIface_ hsc_env + mi_docs = docs, + mi_final_exts = (), + mi_ext_fields = emptyExtensibleFields, +- mi_src_hash = ms_hs_hash mod_summary ++ mi_self_recomp_info = self_recomp + } + where + cmp_rule = lexicalCompareFS `on` ifRuleName +diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs +index 886bc12192e..8abf38d5373 100644 +--- a/compiler/GHC/Iface/Recomp.hs ++++ b/compiler/GHC/Iface/Recomp.hs +@@ -171,6 +171,7 @@ data RecompReason + = UnitDepRemoved UnitId + | ModulePackageChanged FastString + | SourceFileChanged ++ | NoSelfRecompInfo + | ThisUnitIdChanged + | ImpurePlugin + | PluginsChanged +@@ -203,6 +204,7 @@ instance Outputable RecompReason where + UnitDepRemoved uid -> ppr uid <+> text "removed" + ModulePackageChanged s -> ftext s <+> text "package changed" + SourceFileChanged -> text "Source file changed" ++ NoSelfRecompInfo -> text "Old interface lacks recompilation info" + ThisUnitIdChanged -> text "-this-unit-id changed" + ImpurePlugin -> text "Impure plugin forced recompilation" + PluginsChanged -> text "Plugins changed" +@@ -373,6 +375,8 @@ checkVersions hsc_env mod_summary iface + -- but we ALSO must make sure the instantiation matches up. See + -- test case bkpcabal04! + ; hsc_env <- getTopEnv ++ ; if not (isSelfRecompilationInterface iface) ++ then return $ outOfDateItemBecause NoSelfRecompInfo Nothing else do { + ; if mi_src_hash iface /= ms_hs_hash mod_summary + then return $ outOfDateItemBecause SourceFileChanged Nothing else do { + ; if not (isHomeModule home_unit (mi_module iface)) +@@ -407,7 +411,7 @@ checkVersions hsc_env mod_summary iface + | u <- mi_usages iface] + ; case recomp of (NeedsRecompile reason) -> return $ OutOfDateItem reason (Just iface) ; _ -> do { + ; return $ UpToDateItem iface +- }}}}}}} ++ }}}}}}}} + where + logger = hsc_logger hsc_env + dflags = hsc_dflags hsc_env +@@ -1210,18 +1214,6 @@ addFingerprints hsc_env iface0 + sorted_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] + sorted_extra_decls = sortOn binding_key <$> mi_extra_decls iface0 + +- -- the flag hash depends on: +- -- - (some of) dflags +- -- it returns two hashes, one that shouldn't change +- -- the abi hash and one that should +- flag_hash <- fingerprintDynFlags hsc_env this_mod putNameLiterally +- +- opt_hash <- fingerprintOptFlags dflags putNameLiterally +- +- hpc_hash <- fingerprintHpcFlags dflags putNameLiterally +- +- plugin_hash <- fingerprintPlugins (hsc_plugins hsc_env) +- + -- the ABI hash depends on: + -- - decls + -- - export list +@@ -1233,29 +1225,18 @@ addFingerprints hsc_env iface0 + export_hash, -- includes orphan_hash + mi_warns iface0) + +- -- The interface hash depends on: +- -- - the ABI hash, plus +- -- - the source file hash, +- -- - the module level annotations, +- -- - usages +- -- - deps (home and external packages, dependent files) +- -- - hpc +- iface_hash <- computeFingerprint putNameLiterally +- (mod_hash, +- mi_src_hash iface0, +- ann_fn (mkVarOccFS (fsLit "module")), -- See mkIfaceAnnCache +- mi_usages iface0, +- sorted_deps, +- mi_hpc iface0) ++ -- the flag hash depends on: ++ -- - (some of) dflags ++ -- it returns two hashes, one that shouldn't change ++ -- the abi hash and one that should ++ self_recomp <- if gopt Opt_WriteSelfRecompInfo dflags ++ then mkSelfRecomp mod_hash sorted_deps ++ else return NoSelfRecompBackend + + let + final_iface_exts = ModIfaceBackend +- { mi_iface_hash = iface_hash ++ { mi_self_recomp_backend_info = self_recomp + , mi_mod_hash = mod_hash +- , mi_flag_hash = flag_hash +- , mi_opt_hash = opt_hash +- , mi_hpc_hash = hpc_hash +- , mi_plugin_hash = plugin_hash + , mi_orphan = not ( all ifRuleAuto orph_rules + -- See Note [Orphans and auto-generated rules] + && null orph_insts +@@ -1280,6 +1261,38 @@ addFingerprints hsc_env iface0 + (non_orph_fis, orph_fis) = mkOrphMap ifFamInstOrph (mi_fam_insts iface0) + ann_fn = mkIfaceAnnCache (mi_anns iface0) + ++ mkSelfRecomp mod_hash sorted_deps = do ++ ++ flag_hash <- fingerprintDynFlags hsc_env this_mod putNameLiterally ++ ++ opt_hash <- fingerprintOptFlags dflags putNameLiterally ++ ++ hpc_hash <- fingerprintHpcFlags dflags putNameLiterally ++ ++ plugin_hash <- fingerprintPlugins (hsc_plugins hsc_env) ++ ++ -- The interface hash depends on: ++ -- - the ABI hash, plus ++ -- - the source file hash, ++ -- - the module level annotations, ++ -- - usages ++ -- - deps (home and external packages, dependent files) ++ -- - hpc ++ iface_hash <- computeFingerprint putNameLiterally ++ (mod_hash, ++ mi_src_hash iface0, ++ ann_fn (mkVarOccFS (fsLit "module")), -- See mkIfaceAnnCache ++ mi_usages iface0, ++ sorted_deps, ++ mi_hpc iface0) ++ ++ return (ModIfaceSelfRecompBackend ++ { mi_sr_flag_hash = flag_hash ++ , mi_sr_hpc_hash = hpc_hash ++ , mi_sr_opt_hash = opt_hash ++ , mi_sr_iface_hash = iface_hash ++ , mi_sr_plugin_hash = plugin_hash }) ++ + -- | Retrieve the orphan hashes 'mi_orphan_hash' for a list of modules + -- (in particular, the orphan modules which are transitively imported by the + -- current module). +diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs +index 33b75e3eb15..014ffe33c2e 100644 +--- a/compiler/GHC/Tc/Errors/Ppr.hs ++++ b/compiler/GHC/Tc/Errors/Ppr.hs +@@ -1223,6 +1223,9 @@ instance Diagnostic TcRnMessage where + TcRnSectionWithoutParentheses expr -> mkSimpleDecorated $ + hang (text "A section must be enclosed in parentheses") + 2 (text "thus:" <+> (parens (ppr expr))) ++ TcRnReifyModuleMissingInfo m -> mkSimpleDecorated $ ++ vcat [ (ppr m) <+> text "can't be reified due to missing information in its interface file." ++ , text "Possible cause:" <+> ppr m <+> text "was compiled with -fno-write-self-recomp-info" ] + + + diagnosticReason = \case +@@ -1628,6 +1631,8 @@ instance Diagnostic TcRnMessage where + -> ErrorWithoutFlag + TcRnIllegalTupleSection{} + -> ErrorWithoutFlag ++ TcRnReifyModuleMissingInfo {} -> ++ WarningWithFlag Opt_WarnReifyModuleMissingInfo + + diagnosticHints = \case + TcRnUnknownMessage m +@@ -2037,6 +2042,7 @@ instance Diagnostic TcRnMessage where + -> noHints + TcRnIllegalTupleSection{} + -> [suggestExtension LangExt.TupleSections] ++ TcRnReifyModuleMissingInfo {} -> noHints + + + diagnosticCode = constructorCode +diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs +index 335e7c49653..b7b1a32b871 100644 +--- a/compiler/GHC/Tc/Errors/Types.hs ++++ b/compiler/GHC/Tc/Errors/Types.hs +@@ -2762,6 +2762,12 @@ data TcRnMessage where + -} + TcRnSectionWithoutParentheses :: HsExpr GhcPs -> TcRnMessage + ++ {-| TcRnReifyModuleMissingInfo is a warning triggered by attempting to ++ call reifyModule on a module whose interface file lacks the necessary information ++ to satisfy the query. This normally occurs when the module is compiled with `-fno-write-self-recomp-info`. ++ -} ++ TcRnReifyModuleMissingInfo:: Module -> TcRnMessage ++ + deriving Generic + + -- | Things forbidden in @type data@ declarations. +diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs +index 6ba304be169..3bbe9a9af7c 100644 +--- a/compiler/GHC/Tc/Gen/Splice.hs ++++ b/compiler/GHC/Tc/Gen/Splice.hs +@@ -2808,6 +2808,10 @@ modToTHMod :: Module -> TH.Module + modToTHMod m = TH.Module (TH.PkgName $ unitString $ moduleUnit m) + (TH.ModName $ moduleNameString $ moduleName m) + ++-- | Note that reifyModule will not work if the module is compiled with `-fno-write-self-recomp-info` ++-- because the implementation works by consulting the `mi_usages` field which is intended to be only ++-- used for recompilation checking. See #8489 for a ticket which tracks improvement ++-- of this function. + reifyModule :: TH.Module -> TcM TH.ModuleInfo + reifyModule (TH.Module (TH.PkgName pkgString) (TH.ModName mString)) = do + this_mod <- getModule +@@ -2820,9 +2824,20 @@ reifyModule (TH.Module (TH.PkgName pkgString) (TH.ModName mString)) = do + + reifyFromIface reifMod = do + iface <- loadInterfaceForModule (text "reifying module from TH for" <+> ppr reifMod) reifMod +- let usages = [modToTHMod m | usage <- mi_usages iface, +- Just m <- [usageToModule (moduleUnit reifMod) usage] ] +- return $ TH.ModuleInfo usages ++ case mi_self_recomp_info iface of ++ NoSelfRecomp -> do ++ -- Arguably this should fail here but GHC.Prim always has NoSelfRecomp, so ++ -- any existing traversals would just stop working. Now they will start warning ++ -- and a user is expected to add a special case to avoid GHC.Prim in their traversal. ++ ++ -- An alternative would be to add that special case for GHC.Prim here and make it a hard ++ -- error if reifyModule was attempted to be used with these partial interface files. ++ addDiagnosticTc (TcRnReifyModuleMissingInfo reifMod) ++ return (TH.ModuleInfo []) ++ ModIfaceSelfRecomp{ mi_sr_usages } -> do ++ let usages = [modToTHMod m | usage <- mi_sr_usages ++ , Just m <- [usageToModule (moduleUnit reifMod) usage] ] ++ return $ TH.ModuleInfo usages + + usageToModule :: Unit -> Usage -> Maybe Module + usageToModule _ (UsageFile {}) = Nothing +diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs +index ad8028ef387..e157c14a2ba 100644 +--- a/compiler/GHC/Types/Error/Codes.hs ++++ b/compiler/GHC/Types/Error/Codes.hs +@@ -500,6 +500,8 @@ type family GhcDiagnosticCode c = n | n -> c where + GhcDiagnosticCode "TcRnMissingClassAssoc" = 06205 + GhcDiagnosticCode "TcRnBadFamInstDecl" = 06206 + GhcDiagnosticCode "TcRnNotOpenFamily" = 06207 ++ GhcDiagnosticCode "TcRnReifyModuleMissingInfo" = 89264 ++ + + -- IllegalNewtypeReason + GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 +diff --git a/compiler/GHC/Unit/Module/ModGuts.hs b/compiler/GHC/Unit/Module/ModGuts.hs +index d54e836d714..9f14ba91651 100644 +--- a/compiler/GHC/Unit/Module/ModGuts.hs ++++ b/compiler/GHC/Unit/Module/ModGuts.hs +@@ -52,7 +52,7 @@ data ModGuts + mg_exports :: ![AvailInfo], -- ^ What it exports + mg_deps :: !Dependencies, -- ^ What it depends on, directly or + -- otherwise +- mg_usages :: ![Usage], -- ^ What was used? Used for interfaces. ++ mg_usages :: !(Maybe [Usage]), -- ^ What was used? Used for interfaces. + + mg_used_th :: !Bool, -- ^ Did we run a TH splice? + mg_rdr_env :: !GlobalRdrEnv, -- ^ Top-level lexical environment +diff --git a/compiler/GHC/Unit/Module/ModIface.hs b/compiler/GHC/Unit/Module/ModIface.hs +index 1d5280f4fa7..9a748c9ea0b 100644 +--- a/compiler/GHC/Unit/Module/ModIface.hs ++++ b/compiler/GHC/Unit/Module/ModIface.hs +@@ -3,12 +3,16 @@ + {-# LANGUAGE FlexibleContexts #-} + {-# LANGUAGE FlexibleInstances #-} + {-# LANGUAGE UndecidableInstances #-} ++{-# LANGUAGE NamedFieldPuns #-} + + module GHC.Unit.Module.ModIface + ( ModIface + , ModIface_ (..) + , PartialModIface + , ModIfaceBackend (..) ++ , ModIfaceSelfRecompBackend (..) ++ , ModIfaceSelfRecomp (..) ++ , isSelfRecompilationInterface + , IfaceDeclExts + , IfaceBackendExts + , IfaceExport +@@ -19,6 +23,13 @@ module GHC.Unit.Module.ModIface + , mi_semantic_module + , mi_free_holes + , mi_mnwib ++ , mi_flag_hash ++ , mi_iface_hash ++ , mi_opt_hash ++ , mi_hpc_hash ++ , mi_plugin_hash ++ , mi_usages ++ , mi_src_hash + , renameFreeHoles + , emptyPartialModIface + , emptyFullModIface +@@ -57,6 +68,9 @@ import GHC.Utils.Binary + + import Control.DeepSeq + import Control.Exception ++import GHC.Utils.Panic ++import GHC.Utils.Outputable ++import GHC.Utils.Misc + + {- Note [Interface file stages] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +@@ -82,19 +96,11 @@ type ModIface = ModIface_ 'ModIfaceFinal + -- * Or computed just before writing the iface to disk. (Hashes) + -- In order to fully instantiate it. + data ModIfaceBackend = ModIfaceBackend +- { mi_iface_hash :: !Fingerprint +- -- ^ Hash of the whole interface +- , mi_mod_hash :: !Fingerprint ++ { mi_mod_hash :: !Fingerprint + -- ^ Hash of the ABI only +- , mi_flag_hash :: !Fingerprint +- -- ^ Hash of the important flags used when compiling the module, excluding +- -- optimisation flags +- , mi_opt_hash :: !Fingerprint +- -- ^ Hash of optimisation flags +- , mi_hpc_hash :: !Fingerprint +- -- ^ Hash of hpc flags +- , mi_plugin_hash :: !Fingerprint +- -- ^ Hash of plugins ++ , mi_self_recomp_backend_info :: !ModIfaceSelfRecompBackend ++ -- ^ Information needed for checking self-recompilation. ++ -- See Note [Self recompilation information in interface files] + , mi_orphan :: !WhetherHasOrphans + -- ^ Whether this module has orphans + , mi_finsts :: !WhetherHasFamInst +@@ -136,6 +142,81 @@ type family IfaceBackendExts (phase :: ModIfacePhase) = bk | bk -> phase where + IfaceBackendExts 'ModIfaceCore = () + IfaceBackendExts 'ModIfaceFinal = ModIfaceBackend + ++-- | The information for a module which is only used when deciding whether to recompile ++-- itself. In particular the external interface of a module is recorded by the ABI ++-- hash ++data ModIfaceSelfRecompBackend = NoSelfRecompBackend | ModIfaceSelfRecompBackend { ++ mi_sr_flag_hash :: !Fingerprint ++ -- ^ Hash of the important flags used when compiling the module, excluding ++ -- optimisation flags ++ , mi_sr_iface_hash :: !Fingerprint ++ -- ^ Hash of the whole interface ++ , mi_sr_opt_hash :: !Fingerprint ++ -- ^ Hash of optimisation flags ++ , mi_sr_hpc_hash :: !Fingerprint ++ -- ^ Hash of hpc flags ++ , mi_sr_plugin_hash :: !Fingerprint ++ -- ^ Hash of plugins ++} ++withSelfRecompBackend :: HasCallStack => (ModIfaceSelfRecompBackend-> t) -> ModIfaceBackend-> t ++ ++withSelfRecompBackend f mi = ++ case mi_self_recomp_backend_info mi of ++ NoSelfRecompBackend -> panic "Trying to use self-recomp info" ++ x -> f x ++ ++mi_flag_hash :: HasCallStack => ModIfaceBackend -> Fingerprint ++mi_flag_hash = withSelfRecompBackend mi_sr_flag_hash ++mi_iface_hash :: HasCallStack => ModIfaceBackend -> Fingerprint ++mi_iface_hash = withSelfRecompBackend mi_sr_iface_hash ++mi_opt_hash :: HasCallStack => ModIfaceBackend -> Fingerprint ++mi_opt_hash = withSelfRecompBackend mi_sr_opt_hash ++mi_hpc_hash :: HasCallStack => ModIfaceBackend -> Fingerprint ++mi_hpc_hash = withSelfRecompBackend mi_sr_hpc_hash ++mi_plugin_hash :: HasCallStack => ModIfaceBackend -> Fingerprint ++mi_plugin_hash = withSelfRecompBackend mi_sr_plugin_hash ++ ++isSelfRecompilationInterface :: ModIface -> Bool ++isSelfRecompilationInterface iface = ++ case mi_self_recomp_info iface of ++ NoSelfRecomp -> False ++ ModIfaceSelfRecomp {} -> True ++ ++{- ++Note [Self recompilation information in interface files] ++~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ++ ++The flag -fwrite-self-recomp-info controls whether ++interface files contain the information necessary to answer the ++question: ++ ++ Do I need to recompile myself or is this current interface file ++ suitable? ++ ++Why? Most packages are only built once either by a distribution or cabal ++and then placed into an immutable store, after which we will never ask ++this question. Therefore we can derive two benefits from omitting this ++information. ++ ++* Primary motivation: It vastly reduces the surface area for creating ++ non-deterministic interface files. See issue #10424 which motivated a ++ proper fix to that issue. Distributions have long contained versions ++ of GHC which just have broken self-recompilation checking (in order to ++ get deterministic interface files). ++ ++* Secondary motivation: This reduces the size of interface files ++ slightly.. the `mi_usages` field can be quite big but probably this ++ isn't such a great benefit. ++ ++* Third motivation: Conceptually clarity about which parts of an ++ interface file are used in order to **communicate** with subsequent ++ packages about the **interface** for a module. And which parts are ++ used to self-communicate during recompilation checking. ++ ++The main tracking issue is #22188 but fixes issues such as #10424 in a ++proper way. ++ ++-} + + + -- | A 'ModIface' plus a 'ModDetails' summarises everything we know +@@ -162,12 +243,6 @@ data ModIface_ (phase :: ModIfacePhase) + -- consulted for directly-imported modules, but not + -- for anything else (hence lazy) + +- mi_usages :: [Usage], +- -- ^ Usages; kept sorted so that it's easy to decide +- -- whether to write a new iface file (changing usages +- -- doesn't affect the hash of this module) +- -- NOT STRICT! we read this field lazily from the interface file +- -- It is *only* consulted by the recompilation checker + + mi_exports :: ![IfaceExport], + -- ^ Exports +@@ -259,10 +334,40 @@ data ModIface_ (phase :: ModIfacePhase) + -- chosen over `ByteString`s. + -- + +- mi_src_hash :: !Fingerprint +- -- ^ Hash of the .hs source, used for recompilation checking. ++ mi_self_recomp_info :: !ModIfaceSelfRecomp ++ -- ^ Information needed for checking self-recompilation. ++ -- See Note [Self recompilation information in interface files] + } + ++data ModIfaceSelfRecomp = NoSelfRecomp ++ | ModIfaceSelfRecomp { mi_sr_src_hash :: !Fingerprint ++ -- ^ Hash of the .hs source, used for recompilation checking. ++ , mi_sr_usages :: [Usage] ++ -- ^ Usages; kept sorted so that it's easy to decide ++ -- whether to write a new iface file (changing usages ++ -- doesn't affect the hash of this module) ++ -- NOT STRICT! we read this field lazily from the interface file ++ -- It is *only* consulted by the recompilation checker ++ } ++ ++instance Outputable ModIfaceSelfRecomp where ++ ppr NoSelfRecomp = text "NoSelfRecomp" ++ ppr (ModIfaceSelfRecomp{mi_sr_src_hash, mi_sr_usages}) = vcat [text "Self-Recomp" ++ , nest 2 (vcat [text "src hash:" <+> ppr mi_sr_src_hash ++ , text "usages:" <+> ppr (length mi_sr_usages)])] ++ ++withSelfRecomp :: HasCallStack => (ModIfaceSelfRecomp-> t) -> ModIface_ phase -> t ++withSelfRecomp f mi = ++ case mi_self_recomp_info mi of ++ NoSelfRecomp -> panic "Trying to use self-recomp info" ++ x -> f x ++ ++mi_usages :: HasCallStack => ModIface_ phase -> [Usage] ++mi_usages = withSelfRecomp mi_sr_usages ++mi_src_hash :: HasCallStack => ModIface_ phase -> Fingerprint ++mi_src_hash = withSelfRecomp mi_sr_src_hash ++ ++ + {- + Note [Strictness in ModIface] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +@@ -337,17 +442,53 @@ renameFreeHoles fhs insts = + -- It wasn't actually a hole + | otherwise = emptyUniqDSet + ++instance Binary ModIfaceSelfRecompBackend where ++ put_ bh NoSelfRecompBackend = put_ bh (0 :: Int) ++ put_ bh (ModIfaceSelfRecompBackend {mi_sr_flag_hash, mi_sr_iface_hash, mi_sr_plugin_hash, mi_sr_opt_hash, mi_sr_hpc_hash}) = do ++ put_ bh (1 :: Int) ++ put_ bh mi_sr_flag_hash ++ put_ bh mi_sr_iface_hash ++ put_ bh mi_sr_plugin_hash ++ put_ bh mi_sr_opt_hash ++ put_ bh mi_sr_hpc_hash ++ ++ get bh = do ++ (tag :: Int) <- get bh ++ case tag of ++ 0 -> return NoSelfRecompBackend ++ 1 -> do ++ mi_sr_flag_hash <- get bh ++ mi_sr_iface_hash <- get bh ++ mi_sr_plugin_hash <- get bh ++ mi_sr_opt_hash <- get bh ++ mi_sr_hpc_hash <- get bh ++ return (ModIfaceSelfRecompBackend {mi_sr_flag_hash, mi_sr_iface_hash, mi_sr_plugin_hash, mi_sr_opt_hash, mi_sr_hpc_hash}) ++ x -> pprPanic "get_ModIfaceSelfRecomp" (ppr x) ++ ++instance Binary ModIfaceSelfRecomp where ++ put_ bh NoSelfRecomp = put_ bh (0 :: Int) ++ put_ bh (ModIfaceSelfRecomp{mi_sr_src_hash, mi_sr_usages}) = do ++ put_ bh (1 :: Int) ++ put_ bh mi_sr_src_hash ++ lazyPut bh mi_sr_usages ++ ++ get bh = do ++ (tag :: Int) <- get bh ++ case tag of ++ 0 -> return NoSelfRecomp ++ 1 -> do ++ src_hash <- get bh ++ usages <- {-# SCC "bin_usages" #-} lazyGet bh ++ return $ ModIfaceSelfRecomp { mi_sr_src_hash = src_hash, mi_sr_usages = usages } ++ x -> pprPanic "get_ModIfaceSelfRecomp" (ppr x) ++ + -- See Note [Strictness in ModIface] about where we use lazyPut vs put + instance Binary ModIface where + put_ bh (ModIface { + mi_module = mod, + mi_sig_of = sig_of, + mi_hsc_src = hsc_src, +- mi_src_hash = _src_hash, -- Don't `put_` this in the instance +- -- because we are going to write it +- -- out separately in the actual file + mi_deps = deps, +- mi_usages = usages, + mi_exports = exports, + mi_used_th = used_th, + mi_fixities = fixities, +@@ -366,13 +507,10 @@ instance Binary ModIface where + mi_ext_fields = _ext_fields, -- Don't `put_` this in the instance so we + -- can deal with it's pointer in the header + -- when we write the actual file ++ mi_self_recomp_info = self_recomp, + mi_final_exts = ModIfaceBackend { +- mi_iface_hash = iface_hash, ++ mi_self_recomp_backend_info = self_recomp_backend, + mi_mod_hash = mod_hash, +- mi_flag_hash = flag_hash, +- mi_opt_hash = opt_hash, +- mi_hpc_hash = hpc_hash, +- mi_plugin_hash = plugin_hash, + mi_orphan = orphan, + mi_finsts = hasFamInsts, + mi_exp_hash = exp_hash, +@@ -381,16 +519,12 @@ instance Binary ModIface where + put_ bh mod + put_ bh sig_of + put_ bh hsc_src +- put_ bh iface_hash ++ put_ bh self_recomp ++ put_ bh self_recomp_backend + put_ bh mod_hash +- put_ bh flag_hash +- put_ bh opt_hash +- put_ bh hpc_hash +- put_ bh plugin_hash + put_ bh orphan + put_ bh hasFamInsts + lazyPut bh deps +- lazyPut bh usages + put_ bh exports + put_ bh exp_hash + put_ bh used_th +@@ -413,16 +547,12 @@ instance Binary ModIface where + mod <- get bh + sig_of <- get bh + hsc_src <- get bh +- iface_hash <- get bh ++ self_recomp_info <- get bh ++ self_recomp_backend_info <- get bh + mod_hash <- get bh +- flag_hash <- get bh +- opt_hash <- get bh +- hpc_hash <- get bh +- plugin_hash <- get bh + orphan <- get bh + hasFamInsts <- get bh + deps <- lazyGet bh +- usages <- {-# SCC "bin_usages" #-} lazyGet bh + exports <- {-# SCC "bin_exports" #-} get bh + exp_hash <- get bh + used_th <- get bh +@@ -444,10 +574,7 @@ instance Binary ModIface where + mi_module = mod, + mi_sig_of = sig_of, + mi_hsc_src = hsc_src, +- mi_src_hash = fingerprint0, -- placeholder because this is dealt +- -- with specially when the file is read + mi_deps = deps, +- mi_usages = usages, + mi_exports = exports, + mi_used_th = used_th, + mi_anns = anns, +@@ -467,13 +594,10 @@ instance Binary ModIface where + mi_docs = docs, + mi_ext_fields = emptyExtensibleFields, -- placeholder because this is dealt + -- with specially when the file is read ++ mi_self_recomp_info = self_recomp_info, + mi_final_exts = ModIfaceBackend { +- mi_iface_hash = iface_hash, ++ mi_self_recomp_backend_info = self_recomp_backend_info, + mi_mod_hash = mod_hash, +- mi_flag_hash = flag_hash, +- mi_opt_hash = opt_hash, +- mi_hpc_hash = hpc_hash, +- mi_plugin_hash = plugin_hash, + mi_orphan = orphan, + mi_finsts = hasFamInsts, + mi_exp_hash = exp_hash, +@@ -491,9 +615,7 @@ emptyPartialModIface mod + = ModIface { mi_module = mod, + mi_sig_of = Nothing, + mi_hsc_src = HsSrcFile, +- mi_src_hash = fingerprint0, + mi_deps = noDependencies, +- mi_usages = [], + mi_exports = [], + mi_used_th = False, + mi_fixities = [], +@@ -511,6 +633,7 @@ emptyPartialModIface mod + mi_complete_matches = [], + mi_docs = Nothing, + mi_final_exts = (), ++ mi_self_recomp_info = NoSelfRecomp, + mi_ext_fields = emptyExtensibleFields + } + +@@ -518,13 +641,9 @@ emptyFullModIface :: Module -> ModIface + emptyFullModIface mod = + (emptyPartialModIface mod) + { mi_decls = [] +- , mi_final_exts = ModIfaceBackend +- { mi_iface_hash = fingerprint0, ++ , mi_final_exts = ModIfaceBackend { + mi_mod_hash = fingerprint0, +- mi_flag_hash = fingerprint0, +- mi_opt_hash = fingerprint0, +- mi_hpc_hash = fingerprint0, +- mi_plugin_hash = fingerprint0, ++ mi_self_recomp_backend_info = NoSelfRecompBackend, -- TODO + mi_orphan = False, + mi_finsts = False, + mi_exp_hash = fingerprint0, +@@ -550,19 +669,31 @@ emptyIfaceHashCache _occ = Nothing + -- Take care, this instance only forces to the degree necessary to + -- avoid major space leaks. + instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclExts (phase :: ModIfacePhase))) => NFData (ModIface_ phase) where +- rnf (ModIface f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 ++ rnf (ModIface f1 f2 f3 f4 f6 f7 f8 f9 f10 f11 f12 + f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24) = +- rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f5 `seq` f6 `seq` rnf f7 `seq` f8 `seq` ++ rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f6 `seq` rnf f7 `seq` f8 `seq` + f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` f13 `seq` rnf f14 `seq` rnf f15 `seq` rnf f16 `seq` + rnf f17 `seq` f18 `seq` rnf f19 `seq` rnf f20 `seq` f21 `seq` f22 `seq` f23 `seq` rnf f24 + `seq` () + + + instance NFData (ModIfaceBackend) where +- rnf (ModIfaceBackend f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13) ++ rnf (ModIfaceBackend f1 f2 f3 f4 f5 f6 f7 f8 f9) + = rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` + rnf f5 `seq` rnf f6 `seq` rnf f7 `seq` rnf f8 `seq` +- rnf f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` rnf f13 ++ rnf f9 ++ ++instance NFData ModIfaceSelfRecompBackend where ++ -- Sufficient as all fields are strict (and simple) ++ rnf NoSelfRecompBackend = () ++ -- Written like this so if you add another field you have to think about it ++ rnf !(ModIfaceSelfRecompBackend _ _ _ _ _) = () ++instance NFData ModIfaceSelfRecomp where ++ -- Sufficient as all fields are strict (and simple) ++ rnf NoSelfRecomp = () ++ -- MP: Note does not deeply force Usages but the old ModIface logic didn't either, so ++ -- I left it as a shallow force. ++ rnf (ModIfaceSelfRecomp src_hash usages) = src_hash `seq` usages `seq` () + + + forceModIface :: ModIface -> IO () +diff --git a/docs/users_guide/phases.rst b/docs/users_guide/phases.rst +index aa171c2055b..b9557193985 100644 +--- a/docs/users_guide/phases.rst ++++ b/docs/users_guide/phases.rst +@@ -653,6 +653,24 @@ Options affecting code generation + depend on the optimisation level. Any definitions which are already included in + an interface file (via an unfolding for an exported identifier) are reused. + ++.. ghc-flag:: -fwrite-self-recomp-info ++ :shortdesc: Write information for self-recompilation checking in an interface file ++ :type: dynamic ++ :category: codegen ++ ++ :default: on ++ ++ Include information in an interface file which can be used in future to determine ++ whether we need to recompile a module or can reuse the existing interface. ++ ++ This is intended to be turned off in situations where you know you will never try ++ to recompile a module, such as when compiling a package for distribution. ++ The advantage is that by omitting unecessary information to do with dependencies ++ there is less chance of build paths leaking into the interface file and affecting ++ determinism. ++ ++ ++ + + .. ghc-flag:: -fobject-code + :shortdesc: Generate object code +diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst +index 977bb699410..d61fc46319c 100644 +--- a/docs/users_guide/using-warnings.rst ++++ b/docs/users_guide/using-warnings.rst +@@ -2355,6 +2355,21 @@ of ``-W(no-)*``. + triggered whenever this happens, and can be addressed by enabling the + extension. + ++.. ghc-flag:: -Wreify-module-missing-info ++ :shortdesc: warn when `reifyModule` ++ :type: dynamic ++ :reverse: -Wno-reify-module-missing-info ++ ++ :since: 9.6.1 ++ ++ The `reifyModule` function in the Template Haskell API can fail to find the necessary ++ information when an interface file is generated with `-fno-write-self-recomp-info`. This ++ is due to a shortcoming in `reifyModule` tracked by :ghc-ticket:`8489`. ++ ++ This flag warns the user when they try to call `reifyModule` on a module where this ++ situation occurs so that they know the traversal has ended prematurely. ++ ++ + If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice. + It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's + sanity, not yours.) +diff --git a/testsuite/tests/annotations/should_compile/th/annth_compunits.stderr b/testsuite/tests/annotations/should_compile/th/annth_compunits.stderr +new file mode 100644 +index 00000000000..417b2a5a567 +--- /dev/null ++++ b/testsuite/tests/annotations/should_compile/th/annth_compunits.stderr +@@ -0,0 +1,11 @@ ++ ++annth.hs:12:4: warning: [GHC-89264] [-Wreify-module-missing-info (in -Wdefault)] ++ • GHC.Prim can't be reified due to missing information in its interface file. ++ Possible cause: GHC.Prim was compiled with -fno-write-self-recomp-info ++ • In the untyped splice: ++ $(do anns <- traverseModuleAnnotations ++ runIO $ print (anns :: [String]) ++ anns <- reifyAnnotations (AnnLookupName 'testValue) ++ runIO $ print (anns :: [String]) ++ anns <- reifyAnnotations (AnnLookupName 'testValueTH) ++ ....) +diff --git a/testsuite/tests/annotations/should_compile/th/annth_make.stderr b/testsuite/tests/annotations/should_compile/th/annth_make.stderr +new file mode 100644 +index 00000000000..417b2a5a567 +--- /dev/null ++++ b/testsuite/tests/annotations/should_compile/th/annth_make.stderr +@@ -0,0 +1,11 @@ ++ ++annth.hs:12:4: warning: [GHC-89264] [-Wreify-module-missing-info (in -Wdefault)] ++ • GHC.Prim can't be reified due to missing information in its interface file. ++ Possible cause: GHC.Prim was compiled with -fno-write-self-recomp-info ++ • In the untyped splice: ++ $(do anns <- traverseModuleAnnotations ++ runIO $ print (anns :: [String]) ++ anns <- reifyAnnotations (AnnLookupName 'testValue) ++ runIO $ print (anns :: [String]) ++ anns <- reifyAnnotations (AnnLookupName 'testValueTH) ++ ....) +diff --git a/testsuite/tests/driver/self-recomp/Makefile b/testsuite/tests/driver/self-recomp/Makefile +new file mode 100644 +index 00000000000..c6ac89fba19 +--- /dev/null ++++ b/testsuite/tests/driver/self-recomp/Makefile +@@ -0,0 +1,38 @@ ++TOP=../../.. ++include $(TOP)/mk/boilerplate.mk ++include $(TOP)/mk/test.mk ++ ++TEST_HC_OPTS_NO_RTSOPTS = $(filter-out -rtsopts,$(TEST_HC_OPTS)) ++ ++# ----------------------------------------------------------------------------- ++# One-shot compilations, non-hierarchical modules ++ ++# Check that modifying flags doesn't affect interface ++SelfRecomp01: ++ "$(TEST_HC)" $(TEST_HC_OPTS) SelfRecomp01.hs -fno-write-self-recomp-info -v0 ++ "$(TEST_HC)" --show-iface SelfRecomp01.hi > iface1 ++ rm SelfRecomp01.hi ++ "$(TEST_HC)" $(TEST_HC_OPTS) SelfRecomp01.hs -fno-write-self-recomp-info -Iidir -v0 ++ "$(TEST_HC)" --show-iface SelfRecomp01.hi > iface2 ++ diff iface1 iface2 ++ ++# Check that the result of addDependentFile doesn't end up in interface ++SelfRecomp02: ++ "$(TEST_HC)" $(TEST_HC_OPTS) SelfRecomp02.hs -fno-write-self-recomp-info -v0 ++ "$(TEST_HC)" --show-iface SelfRecomp02.hi > iface ++ [ -z $(grep iface SelfRecomp02.hs) ] ++ ++# Check that modifying source doesn't affect interface ++SelfRecomp03: ++ "$(TEST_HC)" $(TEST_HC_OPTS) SelfRecomp03.hs -fno-write-self-recomp-info -v0 ++ "$(TEST_HC)" --show-iface SelfRecomp03.hi > iface1 ++ rm SelfRecomp03.hi ++ echo "" >> SelfRecomp03.hs ++ "$(TEST_HC)" $(TEST_HC_OPTS) SelfRecomp03.hs -fno-write-self-recomp-info -v0 ++ "$(TEST_HC)" --show-iface SelfRecomp03.hi > iface2 ++ diff iface1 iface2 ++ ++# Check that if you don't have recompilation info then you always recompile. ++SelfRecomp04: ++ "$(TEST_HC)" $(TEST_HC_OPTS) SelfRecomp04.hs -fno-write-self-recomp-info -fhide-source-paths ++ "$(TEST_HC)" $(TEST_HC_OPTS) SelfRecomp04.hs -fno-write-self-recomp-info -fhide-source-paths +diff --git a/testsuite/tests/driver/self-recomp/SelfRecomp01.hs b/testsuite/tests/driver/self-recomp/SelfRecomp01.hs +new file mode 100644 +index 00000000000..1d6400e92bc +--- /dev/null ++++ b/testsuite/tests/driver/self-recomp/SelfRecomp01.hs +@@ -0,0 +1,2 @@ ++module SelfRecomp01 where ++ +diff --git a/testsuite/tests/driver/self-recomp/SelfRecomp02.hs b/testsuite/tests/driver/self-recomp/SelfRecomp02.hs +new file mode 100644 +index 00000000000..dd38566b398 +--- /dev/null ++++ b/testsuite/tests/driver/self-recomp/SelfRecomp02.hs +@@ -0,0 +1,6 @@ ++{-# LANGUAGE TemplateHaskell #-} ++module SelfRecomp02 where ++ ++import Language.Haskell.TH.Syntax ++ ++main = $(addDependentFile "SelfRecomp02.hs" >> [| print () |]) +diff --git a/testsuite/tests/driver/self-recomp/SelfRecomp03.hs b/testsuite/tests/driver/self-recomp/SelfRecomp03.hs +new file mode 100644 +index 00000000000..ca181a1f34c +--- /dev/null ++++ b/testsuite/tests/driver/self-recomp/SelfRecomp03.hs +@@ -0,0 +1,2 @@ ++module SelfRecomp03 where ++ +diff --git a/testsuite/tests/driver/self-recomp/SelfRecomp04.hs b/testsuite/tests/driver/self-recomp/SelfRecomp04.hs +new file mode 100644 +index 00000000000..8a956509e90 +--- /dev/null ++++ b/testsuite/tests/driver/self-recomp/SelfRecomp04.hs +@@ -0,0 +1 @@ ++module SelfRecomp04 where +diff --git a/testsuite/tests/driver/self-recomp/SelfRecomp04.stdout b/testsuite/tests/driver/self-recomp/SelfRecomp04.stdout +new file mode 100644 +index 00000000000..5dc637533d1 +--- /dev/null ++++ b/testsuite/tests/driver/self-recomp/SelfRecomp04.stdout +@@ -0,0 +1,2 @@ ++[1 of 1] Compiling SelfRecomp04 ++[1 of 1] Compiling SelfRecomp04 [Old interface lacks recompilation info] +diff --git a/testsuite/tests/driver/self-recomp/all.T b/testsuite/tests/driver/self-recomp/all.T +new file mode 100644 +index 00000000000..91713d459da +--- /dev/null ++++ b/testsuite/tests/driver/self-recomp/all.T +@@ -0,0 +1,4 @@ ++test('SelfRecomp01', normal, makefile_test, ['SelfRecomp01']) ++test('SelfRecomp02', normal, makefile_test, ['SelfRecomp02']) ++test('SelfRecomp03', [copy_files], makefile_test, ['SelfRecomp03']) ++test('SelfRecomp04', normal, makefile_test, ['SelfRecomp04']) +-- +GitLab + diff --git a/cabal-add-riscv64.patch b/cabal-add-riscv64.patch new file mode 100644 index 0000000..e2237d8 --- /dev/null +++ b/cabal-add-riscv64.patch @@ -0,0 +1,43 @@ +diff --git a/libraries/Cabal/Cabal-syntax/src/Distribution/System.hs b/libraries/Cabal/Cabal-syntax/src/Distribution/System.hs +index 68bda63..6521464 100644 +--- a/libraries/Cabal/Cabal-syntax/src/Distribution/System.hs ++++ b/libraries/Cabal/Cabal-syntax/src/Distribution/System.hs +@@ -159,7 +159,7 @@ buildOS = classifyOS Permissive System.Info.os + + -- | These are the known Arches: I386, X86_64, PPC, PPC64, Sparc, + -- Arm, AArch64, Mips, SH, IA64, S390, S390X, Alpha, Hppa, Rs6000, +--- M68k, Vax, JavaScript and Wasm32. ++-- M68k, Vax, RISCV64, JavaScript and Wasm32. + -- + -- The following aliases can also be used: + -- * PPC alias: powerpc +@@ -173,7 +173,7 @@ data Arch = I386 | X86_64 | PPC | PPC64 | Sparc + | Arm | AArch64 | Mips | SH + | IA64 | S390 | S390X + | Alpha | Hppa | Rs6000 +- | M68k | Vax ++ | M68k | Vax | RISCV64 + | JavaScript + | Wasm32 + | OtherArch String +@@ -188,7 +188,7 @@ knownArches = [I386, X86_64, PPC, PPC64, Sparc + ,Arm, AArch64, Mips, SH + ,IA64, S390, S390X + ,Alpha, Hppa, Rs6000 +- ,M68k, Vax ++ ,M68k, Vax, RISCV64 + ,JavaScript + ,Wasm32] + +diff --git a/libraries/Cabal/Cabal/src/Distribution/Simple/PreProcess.hs b/libraries/Cabal/Cabal/src/Distribution/Simple/PreProcess.hs +index fbe5710..a53b33d 100644 +--- a/libraries/Cabal/Cabal/src/Distribution/Simple/PreProcess.hs ++++ b/libraries/Cabal/Cabal/src/Distribution/Simple/PreProcess.hs +@@ -729,6 +729,7 @@ platformDefines lbi = + Rs6000 -> ["rs6000"] + M68k -> ["m68k"] + Vax -> ["vax"] ++ RISCV64 -> ["riscv64"] + JavaScript -> ["javascript"] + Wasm32 -> ["wasm32"] + OtherArch _ -> [] diff --git a/dd38aca95ac25adc9888083669b32ff551151259.patch b/dd38aca95ac25adc9888083669b32ff551151259.patch new file mode 100644 index 0000000..77a7100 --- /dev/null +++ b/dd38aca95ac25adc9888083669b32ff551151259.patch @@ -0,0 +1,26 @@ +From dd38aca95ac25adc9888083669b32ff551151259 Mon Sep 17 00:00:00 2001 +From: Andreas Schwab +Date: Mon, 19 Jun 2023 10:38:26 +0200 +Subject: [PATCH] Hadrian: enable GHCi support on riscv64 + +--- + hadrian/src/Oracles/Setting.hs | 3 ++- + 1 file changed, 2 insertions(+), 1 deletion(-) + +diff --git a/hadrian/src/Oracles/Setting.hs b/hadrian/src/Oracles/Setting.hs +index b9e5d312074..93561a94fe4 100644 +--- a/hadrian/src/Oracles/Setting.hs ++++ b/hadrian/src/Oracles/Setting.hs +@@ -302,7 +302,8 @@ ghcWithInterpreter = do + , "darwin", "kfreebsdgnu" ] + goodArch <- anyTargetArch [ "i386", "x86_64", "powerpc" + , "arm", "aarch64", "s390x" +- , "powerpc64", "powerpc64le" ] ++ , "powerpc64", "powerpc64le" ++ , "riscv64" ] + return $ goodOs && goodArch + + -- | Variants of the ARM architecture. +-- +GitLab + diff --git a/ghc-Cabal-install-PATH-warning.patch b/ghc-Cabal-install-PATH-warning.patch new file mode 100644 index 0000000..133f8ce --- /dev/null +++ b/ghc-Cabal-install-PATH-warning.patch @@ -0,0 +1,13 @@ +--- ghc-9.8.0.20230727/libraries/Cabal/Cabal/src/Distribution/Simple/Install.hs~ 2023-07-27 21:34:28.000000000 +0100 ++++ ghc-9.8.0.20230727/libraries/Cabal/Cabal/src/Distribution/Simple/Install.hs 2023-08-04 14:47:19.782822654 +0100 +@@ -269,9 +269,8 @@ + when (not inPath) $ + warn + verbosity +- ( "The directory " ++ ( "Executable installed in " + ++ binPref +- ++ " is not in the system search path." + ) + case compilerFlavor (compiler lbi) of + GHC -> GHC.installExe verbosity lbi binPref buildPref progFix pkg_descr exe diff --git a/ghc-gen_contents_index-haddock-path.patch b/ghc-gen_contents_index-haddock-path.patch new file mode 100644 index 0000000..e6819ee --- /dev/null +++ b/ghc-gen_contents_index-haddock-path.patch @@ -0,0 +1,10 @@ +--- ghc-7.6.3/libraries/gen_contents_index~ 2013-04-19 06:22:46.000000000 +0900 ++++ ghc-7.6.3/libraries/gen_contents_index 2013-04-22 12:07:48.922152864 +0900 +@@ -60,6 +60,6 @@ + done + else +- HADDOCK=../../../../../bin/haddock ++ HADDOCK=/usr/bin/haddock + # We don't want the GHC API to swamp the index + HADDOCK_FILES=`ls -1 */*.haddock | grep -v '/ghc\.haddock' | sort` + HADDOCK_ARGS="-p prologue.txt" diff --git a/ghc-gen_contents_index-nodocs.patch b/ghc-gen_contents_index-nodocs.patch new file mode 100644 index 0000000..bb7f9a6 --- /dev/null +++ b/ghc-gen_contents_index-nodocs.patch @@ -0,0 +1,11 @@ +--- ghc-8.6.5/libraries/gen_contents_index~ 2020-02-24 15:02:26.318866694 +0800 ++++ ghc-8.6.5/libraries/gen_contents_index 2020-04-09 18:18:40.290722327 +0800 +@@ -47,6 +47,8 @@ + HADDOCK_ARGS="$HADDOCK_ARGS $HADDOCK_ARG" + done + else ++ if ! ls */*.haddock &>/dev/null; then exit 0; fi ++ + HADDOCK=/usr/bin/haddock + # We don't want the GHC API to swamp the index + HADDOCK_FILES=`ls -1 */*.haddock | grep -v '/ghc\.haddock' | sort` diff --git a/ghc-hadrian-s390x-rts--qg.patch b/ghc-hadrian-s390x-rts--qg.patch new file mode 100644 index 0000000..57a9088 --- /dev/null +++ b/ghc-hadrian-s390x-rts--qg.patch @@ -0,0 +1,11 @@ +--- ghc-9.4.1/hadrian/hadrian.cabal~ 2022-08-07 12:00:38.000000000 +0800 ++++ ghc-9.4.1/hadrian/hadrian.cabal 2022-08-10 19:54:33.335164261 +0800 +@@ -173,7 +173,7 @@ + -- waiting for external processes + -- * -qg: Don't use parallel GC as the synchronization + -- time tends to eat any benefit. +- "-with-rtsopts=-I0 -qg" ++ "-with-rtsopts=-I0" + -threaded + + if flag(selftest) diff --git a/ghc-pkg.man b/ghc-pkg.man new file mode 100644 index 0000000..ccac8e4 --- /dev/null +++ b/ghc-pkg.man @@ -0,0 +1,228 @@ +.TH ghc-pkg 1 "2010-01-27" +.SH NAME +ghc-pkg \- GHC Haskell Cabal package manager +.SH SYNOPSIS +.B ghc-pkg +.I action +.RI [ OPTION ]... +.SH DESCRIPTION +A package is a library of Haskell modules known to the compiler. The +.B ghc-pkg +tool allows adding or removing them from a package database. By +default, the system-wide package database is modified, but +alternatively the user's local package database or another specified +file can be used. +.PP +To make a package available for +.BR ghc , +.B ghc-pkg +can be used to register it. Unregistering it removes it from the +database. Also, packages can be hidden, to make +.B ghc +ignore the package by default, without uninstalling it. Exposing a +package makes a hidden package available. Additionally, +.B ghc-pkg +has various commands to query the package database. +.PP +Where a package name is required, the package can be named in full +including the version number (e.g. +.BR network-1.0 ), +or without the version number. Naming a package without the version +number matches all versions of the package; the specified action will +be applied to all the matching packages. A package specifier that +matches all version of the package can also be written +.BR pkg-* , +to make it clearer that multiple packages are being matched. +.SH ACTIONS +.TP +\fBregister\fP \fIfilename\fP|\fB-\fP +Register the package using the specified installed package +description. +.TP +\fBupdate\fP \fIfilename\fP|\fB-\fP +Register the package, overwriting any other package with the same +name. +.TP +\fBunregister\fP \fIpkg-id\fP +Unregister the specified package. +.TP +\fBexpose\fP \fIpkg-id\fP +Expose the specified package. +.TP +\fBhide\fP \fIpkg-id\fP +Hide the specified package +.TP +\fBlist\fP \fR[\fIpkg\fR]...\fP +List registered packages in the global database, and also the user +database if +.B --user +is given. If a package name is given all the registered versions will +be listed in ascending order. Accepts the +.B --simple-output +flag. +.TP +.B dot +Generate a graph of the package dependencies in a form suitable for +input for the graphviz tools. For example, to generate a PDF of the +dependency graph: +.br +\fB dot \| tred \| dot -Tpdf >pkgs.pdf\fP +.TP +\fBfind-module\fP \fImodule\fP +List registered packages exposing module +.I module +in the global database, and also the user database if +.B --user +is given. All the registered versions will be listed in ascending +order. Accepts the +.B --simple-output +flag. +.TP +\fBlatest\fP \fIpkg-id\fP +Prints the highest registered version of a package. +.TP +.B check +Check the consistency of package dependencies and list broken +packages. Accepts the +.B --simple-output +flag. +.TP +\fBdescribe\fP \fIpkg\fP +Give the registered description for the +specified package. The description is returned in precisely the syntax +required by ghc-pkg register. +.TP +\fBfield\fP \fIpkg field\fP +Extract the specified field of the package description for the +specified package. Accepts comma-separated multiple fields. +.TP +.B dump +Dump the registered description for every package. This is like +.BR ghc-pkg\ describe\ '*' , +expect that it is intended to be used by tools that parse the results, +rather than humans. +.TP +.B recache +Regenerate the package database cache. This command should only be +necessary if you added a package to the database by dropping a file +into the database directory manyally. By default, the global DB is +recached; to recache a different DB use +.B --user +or +.B --package-conf +as appropriate. +.SH OPTIONS +When asked to modify a database +.RB ( register ,\ unregister ,\ update ,\ hide ,\ expose ,\ and\ also\ check ), +.B ghc-pkg +modifies the global database by +default. Specifying +.B --user +causes it to act on the user database, +or +.B --package-conf +can be used to act on another database +entirely. When multiple of these options are given, the rightmost +one is used as the database to act upon. +.PP +Commands that query the package database +.RB ( list ,\ latest ,\ describe ,\ field ) +operate on the list of databases specified by the flags +.BR --user ,\ --global , +and +.BR --package-conf . +If none of these flags are +given, the default is +.BR --global\ --user . +.TP +.B --user +Use the current user's package database. +.TP +.B --global +Use the global package database. +.TP +\fB-f\fP \fIFILE\fP, \fB--package-conf=\fIFILE\fP +Use the specified package config file. +.TP +.BI --global-conf= FILE +Location of the global package config. +.TP +.B --force +Ignore missing dependencies, directories, and libraries. +.TP +.B --force-files +Ignore missing directories and libraries only. +.TP +.BR -g ,\ --auto-ghc-libs +Automatically build libs for GHCi (with register). +.TP +.BR -? ,\ --help +Display a help message and exit. +.TP +.BR -V ,\ --version +Output version information and exit. +.TP +.B --simple-output +Print output in easy-to-parse format for some commands. +.TP +.B --names-only +Only print package names, not versions; can only be used with +.BR list\ --simple-output . +.TP +.B --ignore-case +Ignore case for substring matching. +.SH ENVIRONMENT VARIABLES +.TP +.B GHC_PACKAGE_PATH +The +.B GHC_PACKAGE_PATH +environment variable may be set to a +.BR : -separated +list of files containing package databases. This list of package +databases is used by +.B ghc +and +.BR ghc-pkg , +with earlier databases in the list overriding later ones. This order +was chosen to match the behaviour of the +.B PATH +environment variable; think of it as a list of package databases that +are searched left-to-right for packages. + +If +.B GHC_PACKAGE_PATH +ends in a separator, then the default user and system package +databases are appended, in that order. e.g. to augment the usual set +of packages with a database of your own, you could say: + +.br +\fB export GHC_PACKAGE_PATH=$HOME/.my-ghc-packages.conf:\fP +.br + +To check whether your +.B GHC_PACKAGE_PATH +setting is doing the right thing, +.B ghc-pkg list +will list all the databases in use, in the reverse order they are +searched. +.SH FILES +Both of these locations are changed for Debian. Upstream still keeps +these under +.IR /usr . +Some programs may refer to that, but look in +.I /var +instead. +.TP +.I /var/lib/ghc/package.conf +Global package.conf file. +.TP +.I /var/lib/ghc/package.conf.d/ +Directory for library specific package.conf files. These are added to +the global registry. +.SH "SEE ALSO" +.BR ghc (1), +.BR runghc (1), +.BR hugs (1). +.SH AUTHOR +This manual page was written by Kari Pahula , for the +Debian project (and may be used by others). diff --git a/ghc9.10.spec b/ghc9.10.spec new file mode 100644 index 0000000..6ca4b3b --- /dev/null +++ b/ghc9.10.spec @@ -0,0 +1,884 @@ +# Start: prod settings +# all *bcond_without* for production builds: +# - performance build (disable for quick build) +%bcond_without perfbuild +%bcond_without manual +%bcond_without build_hadrian +# End: prod settings + +# not for production builds +%if %{without perfbuild} +# disable profiling libraries (overriding macros.ghc-srpm) +%undefine with_ghc_prof +# disable haddock documentation (overriding macros.ghc-os) +%undefine with_haddock +%endif + +%global ghc_major 9.10 +%global ghc_name ghc%{ghc_major} + +# to handle RCs +%global ghc_release %{version} + +%global base_ver 4.20.0.0 +%global ghc_bignum_ver 1.3 +%global ghc_compact_ver 0.1.0.0 +%global hpc_ver 0.7.0.1 +%global rts_ver 1.0.2 +%global xhtml_ver 3000.2.2.1 + +# bootstrap needs 9.6+ +%global ghcboot_major 9.6 +%global ghcboot ghc%{?ghcboot_major} + +# make sure ghc libraries' ABI hashes unchanged +%bcond_with abicheck + +# no longer build testsuite (takes time and not really being used) +%bcond_with testsuite + +# 9.8 needs llvm 11-15 +# rhel9 binutils too old for llvm13: +# https://bugzilla.redhat.com/show_bug.cgi?id=2141054 +# https://gitlab.haskell.org/ghc/ghc/-/issues/22427 +%if 0%{?rhel} == 9 +%global llvm_major 12 +%else +%global llvm_major 15 +%endif +%global ghc_llvm_archs armv7hl s390x riscv64 +%global ghc_unregisterized_arches s390 %{mips} + +Name: %{ghc_name} +Version: 9.10.0.20240313 +# Since library subpackages are versioned: +# - release can only be reset if *all* library versions get bumped simultaneously +# (sometimes after a major release) +# - minor release numbers for a branch should be incremented monotonically +Release: 0.2%{?dist} +Summary: Glasgow Haskell Compiler + +License: BSD-3-Clause AND HaskellReport +URL: https://haskell.org/ghc/ +Source0: https://downloads.haskell.org/ghc/%{ghc_release}/ghc-%{version}-src.tar.xz +%if %{with testsuite} +Source1: https://downloads.haskell.org/ghc/%{ghc_release}/ghc-%{version}-testsuite.tar.xz +%endif +Source5: ghc-pkg.man +Source6: haddock.man +Source7: runghc.man + +# https://bugzilla.redhat.com/show_bug.cgi?id=2083103 +ExcludeArch: armv7hl + +# absolute haddock path (was for html/libraries -> libraries) +Patch1: ghc-gen_contents_index-haddock-path.patch +Patch2: ghc-Cabal-install-PATH-warning.patch +Patch3: ghc-gen_contents_index-nodocs.patch +# https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9604 +# needs more backporting to 9.6 +Patch9: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9604.patch + +# arm patches +# https://github.com/haskell/text/issues/396 +# reverts https://github.com/haskell/text/pull/405 +Patch13: text2-allow-ghc8-arm.patch + +# unregisterised +Patch16: ghc-hadrian-s390x-rts--qg.patch + +# Debian patches: +# bad according to upstream +# see eg https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9604 +#Patch24: buildpath-abi-stability.patch +Patch26: no-missing-haddock-file-warning.patch +Patch27: haddock-remove-googleapis-fonts.patch + +# RISCV64 added to Cabal +# See: https://github.com/haskell/cabal/pull/9062 +Patch40: cabal-add-riscv64.patch + +# Enable GHCi support on riscv64 +# Upstream in >= 9.9. +Patch41: https://gitlab.haskell.org/ghc/ghc/-/commit/dd38aca95ac25adc9888083669b32ff551151259.patch + +# https://gitlab.haskell.org/ghc/ghc/-/wikis/platforms + +# fedora ghc has been bootstrapped on +# %%{ix86} x86_64 ppc ppc64 armv7hl s390 s390x ppc64le aarch64 +# see also deprecated ghc_arches defined in ghc-srpm-macros +# /usr/lib/rpm/macros.d/macros.ghc-srpm + +BuildRequires: %{ghcboot}-compiler +# for ABI hash checking +%if %{with abicheck} +BuildRequires: %{name} +%endif +BuildRequires: ghc-rpm-macros-extra >= 2.6.5 +BuildRequires: %{ghcboot}-array-devel +BuildRequires: %{ghcboot}-binary-devel +BuildRequires: %{ghcboot}-bytestring-devel +BuildRequires: %{ghcboot}-containers-devel +BuildRequires: %{ghcboot}-deepseq-devel +BuildRequires: %{ghcboot}-directory-devel +BuildRequires: %{ghcboot}-filepath-devel +BuildRequires: %{ghcboot}-ghc-boot-th-devel +BuildRequires: %{ghcboot}-pretty-devel +BuildRequires: %{ghcboot}-process-devel +BuildRequires: %{ghcboot}-stm-devel +BuildRequires: %{ghcboot}-template-haskell-devel +BuildRequires: %{ghcboot}-time-devel +BuildRequires: %{ghcboot}-transformers-devel +BuildRequires: %{ghcboot}-unix-devel +BuildRequires: alex +BuildRequires: gmp-devel +BuildRequires: happy +BuildRequires: libffi-devel +BuildRequires: lzip +BuildRequires: make +BuildRequires: gcc-c++ +# for terminfo +BuildRequires: ncurses-devel +BuildRequires: perl-interpreter +BuildRequires: python3 +%if %{with manual} +BuildRequires: python3-sphinx +%endif +%ifarch %{ghc_llvm_archs} +BuildRequires: llvm%{llvm_major} +%endif + +# needed for binary-dist-dir +BuildRequires: autoconf automake +%if %{with build_hadrian} +BuildRequires: ghc-Cabal-devel +BuildRequires: ghc-QuickCheck-devel +BuildRequires: ghc-base-devel +BuildRequires: ghc-base16-bytestring-devel +BuildRequires: ghc-bytestring-devel +BuildRequires: ghc-containers-devel +BuildRequires: ghc-cryptohash-sha256-devel +BuildRequires: ghc-directory-devel +BuildRequires: ghc-extra-devel +BuildRequires: ghc-filepath-devel +BuildRequires: ghc-mtl-devel +BuildRequires: ghc-parsec-devel +BuildRequires: ghc-shake-devel +BuildRequires: ghc-stm-devel +BuildRequires: ghc-transformers-devel +BuildRequires: ghc-unordered-containers-devel +%else +BuildRequires: %{name}-hadrian +%endif + +Requires: %{name}-compiler = %{version}-%{release} +Requires: %{name}-devel = %{version}-%{release} +Requires: %{name}-ghc-devel = %{version}-%{release} +Requires: %{name}-ghc-boot-devel = %{version}-%{release} +Requires: %{name}-ghc-compact-devel = %{ghc_compact_ver}-%{release} +Requires: %{name}-ghc-heap-devel = %{version}-%{release} +Requires: %{name}-ghci-devel = %{version}-%{release} +Requires: %{name}-hpc-devel = %{hpc_ver}-%{release} +%if %{with haddock} +Suggests: %{name}-doc = %{version}-%{release} +Suggests: %{name}-doc-index = %{version}-%{release} +%endif +%if %{with manual} +Suggests: %{name}-manual = %{version}-%{release} +%endif +%if %{with ghc_prof} +Suggests: %{name}-prof = %{version}-%{release} +%endif +Recommends: %{name}-compiler-default = %{version}-%{release} + +%description +GHC is a state-of-the-art, open source, compiler and interactive environment +for the functional language Haskell. Highlights: + +- GHC supports the entire Haskell 2010 language plus a wide variety of + extensions. +- GHC has particularly good support for concurrency and parallelism, + including support for Software Transactional Memory (STM). +- GHC generates fast code, particularly for concurrent programs. + Take a look at GHC's performance on The Computer Language Benchmarks Game. +- GHC works on several platforms including Windows, Mac, Linux, + most varieties of Unix, and several different processor architectures. +- GHC has extensive optimisation capabilities, including inter-module + optimisation. +- GHC compiles Haskell code either directly to native code or using LLVM + as a back-end. GHC can also generate C code as an intermediate target for + porting to new platforms. The interactive environment compiles Haskell to + bytecode, and supports execution of mixed bytecode/compiled programs. +- Profiling is supported, both by time/allocation and various kinds of heap + profiling. +- GHC comes with several libraries, and thousands more are available on Hackage. + + +%package compiler +Summary: GHC compiler and utilities +License: BSD-3-Clause +Requires: gcc%{?_isa} +Requires: %{name}-base-devel%{?_isa} = %{base_ver}-%{release} +%if %{with haddock} +Requires: %{name}-filesystem = %{version}-%{release} +%else +Obsoletes: %{name}-doc-index < %{version}-%{release} +Obsoletes: %{name}-filesystem < %{version}-%{release} +Obsoletes: %{name}-xhtml < %{xhtml_ver}-%{release} +Obsoletes: %{name}-xhtml-devel < %{xhtml_ver}-%{release} +Obsoletes: %{name}-xhtml-doc < %{xhtml_ver}-%{release} +Obsoletes: %{name}-xhtml-prof < %{xhtml_ver}-%{release} +%endif +%if %{without manual} +Obsoletes: %{name}-manual < %{version}-%{release} +%endif +%ifarch %{ghc_llvm_archs} +Requires: llvm%{llvm_major} +%endif + +%description compiler +The package contains the GHC compiler, tools and utilities. + +The ghc libraries are provided by %{name}-devel. +To install all of ghc (including the ghc library), +install the main ghc package. + + +%package compiler-default +Summary: Makes %{name} default ghc +Requires: %{name}-compiler%{?_isa} = %{version}-%{release} +Conflicts: ghc-compiler + +%description compiler-default +The package contains symlinks to make %{name} the default GHC compiler. + + +%if %{with haddock} || %{with manual} +%package doc +Summary: Haskell library documentation meta package +License: BSD-3-Clause + +%description doc +Installing this package causes %{name}-*-doc packages corresponding to +%{name}-*-devel packages to be automatically installed too. + + +%package doc-index +Summary: GHC library documentation indexing +License: BSD-3-Clause +Requires: %{name}-compiler = %{version}-%{release} +BuildArch: noarch + +%description doc-index +The package enables re-indexing of installed library documention. + + +%package filesystem +Summary: Shared directories for Haskell documentation +BuildArch: noarch + +%description filesystem +This package provides some common directories used for +Haskell libraries documentation. +%endif + + +%if %{with manual} +%package manual +Summary: GHC manual +License: BSD-3-Clause +BuildArch: noarch +Requires: %{name}-filesystem = %{version}-%{release} + +%description manual +This package provides the User Guide and Haddock manual. +%endif + +# needed for ghc-rpm-macros macros.ghc +%global with_hadrian 1 + +# ghclibdir also needs ghc_version_override for bootstrapping +%global ghc_version_override %{version} + +%if %{with build_hadrian} +%package hadrian +Summary: GHC Hadrian buildsystem tool +License: MIT +Version: 0.1.0.0 + +%description hadrian +This provides the hadrian tool which can be used to build ghc. +%endif + +%global BSDHaskellReport %{quote:BSD-3-Clause AND HaskellReport} + +# use "./libraries-versions.sh" to check versions +%if %{defined ghclibdir} +%ghc_lib_subpackage -d -l BSD-3-Clause Cabal-3.11.0.0 +%ghc_lib_subpackage -d -l BSD-3-Clause Cabal-syntax-3.11.0.0 +%ghc_lib_subpackage -d -l %BSDHaskellReport array-0.5.6.0 +%ghc_lib_subpackage -d -l %BSDHaskellReport -c gmp-devel%{?_isa},libffi-devel%{?_isa} base-%{base_ver} +%ghc_lib_subpackage -d -l BSD-3-Clause binary-0.8.9.1 +%ghc_lib_subpackage -d -l BSD-3-Clause bytestring-0.12.1.0 +%ghc_lib_subpackage -d -l %BSDHaskellReport containers-0.7 +%ghc_lib_subpackage -d -l %BSDHaskellReport deepseq-1.5.0.0 +%ghc_lib_subpackage -d -l %BSDHaskellReport directory-1.3.8.3 +%ghc_lib_subpackage -d -l %BSDHaskellReport exceptions-0.10.7 +%ghc_lib_subpackage -d -l BSD-3-Clause filepath-1.5.2.0 +# in ghc not ghc-libraries: +%ghc_lib_subpackage -d -x ghc-%{ghc_version_override} +%ghc_lib_subpackage -d -x -l BSD-3-Clause ghc-bignum-%{ghc_bignum_ver} +%ghc_lib_subpackage -d -x -l BSD-3-Clause ghc-boot-%{ghc_version_override} +%ghc_lib_subpackage -d -l BSD-3-Clause ghc-boot-th-%{ghc_version_override} +%ghc_lib_subpackage -d -x -l BSD-3-Clause ghc-compact-%{ghc_compact_ver} +%ghc_lib_subpackage -d -l BSD-3-Clause ghc-experimental-0.1.0.0 +%ghc_lib_subpackage -d -x -l BSD-3-Clause ghc-heap-%{ghc_version_override} +%ghc_lib_subpackage -d -l BSD-3-Clause ghc-internal-9.1001.0 +# see below for ghc-prim +%ghc_lib_subpackage -d -x -l BSD-3-Clause ghci-%{ghc_version_override} +%ghc_lib_subpackage -d -l BSD-3-Clause haskeline-0.8.2.1 +%ghc_lib_subpackage -d -x -l BSD-3-Clause hpc-%{hpc_ver} +# see below for integer-gmp +%ghc_lib_subpackage -d -l BSD-3-Clause mtl-2.3.1 +%ghc_lib_subpackage -d -l BSD-3-Clause parsec-3.1.16.1 +%ghc_lib_subpackage -d -l BSD-3-Clause pretty-1.1.3.6 +%ghc_lib_subpackage -d -l %BSDHaskellReport process-1.6.18.0 +# see below for rts +%ghc_lib_subpackage -d -l BSD-3-Clause semaphore-compat-1.0.0 +%ghc_lib_subpackage -d -l BSD-3-Clause stm-2.5.3.0 +%ghc_lib_subpackage -d -l BSD-3-Clause template-haskell-2.22.0.0 +%ghc_lib_subpackage -d -l BSD-3-Clause -c ncurses-devel%{?_isa} terminfo-0.4.1.6 +%ghc_lib_subpackage -d -l BSD-3-Clause text-2.1.1 +%ghc_lib_subpackage -d -l BSD-3-Clause time-1.12.2 +%ghc_lib_subpackage -d -l BSD-3-Clause transformers-0.6.1.1 +%ghc_lib_subpackage -d -l BSD-3-Clause unix-2.8.5.0 +%ghc_lib_subpackage -d -l BSD-3-Clause xhtml-%{xhtml_ver} +%endif + +%global version %{ghc_version_override} + +%package devel +Summary: GHC development libraries meta package +License: BSD-3-Clause AND HaskellReport +Requires: %{name}-compiler = %{version}-%{release} +Obsoletes: %{name}-libraries < %{version}-%{release} +Provides: %{name}-libraries = %{version}-%{release} +%{?ghc_packages_list:Requires: %(echo %{ghc_packages_list} | sed -e "s/\([^ ]*\)-\([^ ]*\)/%{name}-\1-devel = \2-%{release},/g")} + +%description devel +This is a meta-package for all the development library packages in GHC +except the ghc library, which is installed by the toplevel ghc metapackage. + + +%if %{with ghc_prof} +%package prof +Summary: GHC profiling libraries meta package +License: BSD-3-Clause +Requires: %{name}-compiler = %{version}-%{release} + +%description prof +Installing this package causes %{name}-*-prof packages corresponding to +%{name}-*-devel packages to be automatically installed too. +%endif + + +%prep +%setup -q -n ghc-%{version} %{?with_testsuite:-b1} + +%patch -P1 -p1 -b .orig +%patch -P3 -p1 -b .orig +#%%patch -P2 -p1 -b .orig +#%%patch -P9 -p1 -b .orig + +rm libffi-tarballs/libffi-*.tar.gz + +%ifarch aarch64 armv7hl +%patch -P13 -p1 -b .orig +%endif + +%ifarch %{ghc_unregisterized_arches} riscv64 +%patch -P16 -p1 -b .orig +%endif +# remove if epel9 ghc using llvm +%ifarch s390x +%if %{defined el9} +%patch -P16 -p1 -b .orig +%endif +%endif + +#debian +#%%patch -P24 -p1 -b .orig +%patch -P26 -p1 -b .orig +%patch -P27 -p1 -b .orig + +%ifarch riscv64 +#RISCV64 cabal support +%patch -P40 -p1 -b .orig +#GHCi support +%patch -P41 -p1 -b .orig +%endif + + +%build +# patch4 +autoupdate + +%ghc_set_gcc_flags +export CC=%{_bindir}/gcc +# note lld breaks build-id +# /usr/bin/debugedit: Cannot handle 8-byte build ID +# https://bugzilla.redhat.com/show_bug.cgi?id=2116508 +# https://gitlab.haskell.org/ghc/ghc/-/issues/22195 +%if 0%{fedora} < 40 +export LD=%{_bindir}/ld.gold +%endif + +export GHC=%{_bindir}/ghc%{?ghcboot_major:-%{ghcboot_major}} + +# * %%configure induces cross-build due to different target/host/build platform names +./configure --prefix=%{_prefix} --exec-prefix=%{_exec_prefix} \ + --bindir=%{_bindir} --sbindir=%{_sbindir} --sysconfdir=%{_sysconfdir} \ + --datadir=%{_datadir} --includedir=%{_includedir} --libdir=%{_libdir} \ + --libexecdir=%{_libexecdir} --localstatedir=%{_localstatedir} \ + --sharedstatedir=%{_sharedstatedir} --mandir=%{_mandir} \ + --docdir=%{_docdir}/%{name} \ + --with-system-libffi \ +%if 0%{fedora} >= 40 + --disable-ld-override \ +%endif +%ifarch %{ghc_unregisterized_arches} + --enable-unregisterised \ +%endif +%{nil} + +# avoid "ghc: hGetContents: invalid argument (invalid byte sequence)" +export LANG=C.utf8 + +%if %{defined _ghcdynlibdir} +%undefine _ghcdynlibdir +%endif + +%if %{with build_hadrian} +# do not disable debuginfo with ghc_bin_build +%global ghc_debuginfo 1 +( +cd hadrian +%if 0%{?fedora} >= 38 +%ghc_bin_build -W +%else +%ghc_bin_build +%endif +) +%global hadrian hadrian/dist/build/hadrian/hadrian +%else +%global hadrian %{_bindir}/hadrian-%{ghc_major} +%endif + +%ifarch %{ghc_llvm_archs} +%global hadrian_llvm +llvm +%endif +%define hadrian_docs %{!?with_haddock:--docs=no-haddocks} --docs=%[%{?with_manual} ? "no-sphinx-pdfs" : "no-sphinx"] +# + hadrian/dist/build/hadrian/hadrian -j224 --flavour=perf --docs=no-sphinx-pdfs binary-dist-dir --hash-unit-ids +# # cabal-read (for OracleQ (PackageDataKey (Package {pkgType = Library, pkgName = "rts", pkgPath = "rts"}))) +# rts/include/rts/Messages.h: withFile: resource exhausted (Too many open files) +# https://koji.fedoraproject.org/koji/taskinfo?taskID=111327221 +%global _smp_ncpus_max 64 +# quickest does not build shared libs +# try release instead of perf +%{hadrian} %{?_smp_mflags} --flavour=%[%{?with_perfbuild} ? "perf" : "quick"]%{!?with_ghc_prof:+no_profiled_libs}%{?hadrian_llvm} %{hadrian_docs} binary-dist-dir --hash-unit-ids + + +%install +%if %{with build_hadrian} +( +cd hadrian +%ghc_bin_install +rm %{buildroot}%{_ghclicensedir}/%{name}/LICENSE +cp -p LICENSE ../LICENSE.hadrian +) +%endif +# https://gitlab.haskell.org/ghc/ghc/-/issues/20120#note_366872 +( +cd _build/bindist/ghc-%{version}-* +./configure --prefix=%{buildroot}%{ghclibdir} --bindir=%{buildroot}%{_bindir} --libdir=%{buildroot}%{_libdir} --mandir=%{buildroot}%{_mandir} --docdir=%{buildroot}%{_docdir}/%{name} \ +%if 0%{fedora} >= 40 + --disable-ld-override +%endif +%{nil} +make install +) + +%if "%{?_ghcdynlibdir}" != "%_libdir" +mkdir -p %{buildroot}%{_sysconfdir}/ld.so.conf.d +echo "%{ghclibplatform}" > %{buildroot}%{_sysconfdir}/ld.so.conf.d/%{name}.conf +%else +for i in $(find %{buildroot} -type f -executable -exec sh -c "file {} | grep -q 'dynamically linked'" \; -print); do + chrpath -d $i +done +%endif + +%if %{with haddock} +# remove short hashes +for d in %{buildroot}%{ghc_html_libraries_dir}/*/; do +mv $d $(echo $d | sed -e "s/\(.*\)-.*/\\1/") +done +%endif + +# containers src moved to a subdir +cp -p libraries/containers/containers/LICENSE libraries/containers/LICENSE +# hack for Cabal-syntax/LICENSE +mkdir -p libraries/Cabal-syntax +cp -p libraries/Cabal/Cabal-syntax/LICENSE libraries/Cabal-syntax + +rm -f %{name}-*.files + +# FIXME replace with ghc_subpackages_list +for i in %{ghc_packages_list}; do +name=$(echo $i | sed -e "s/\(.*\)-.*/\1/") +ver=$(echo $i | sed -e "s/.*-\(.*\)/\1/") +%ghc_gen_filelists $name $ver +echo "%%license libraries/$name/LICENSE" >> %{name}-$name.files +done + +echo "%%dir %{ghclibdir}" >> %{name}-base%{?_ghcdynlibdir:-devel}.files +echo "%%dir %{ghcliblib}" >> %{name}-base%{?_ghcdynlibdir:-devel}.files +echo "%%dir %ghclibplatform" >> %{name}-base%{?_ghcdynlibdir:-devel}.files + +%ghc_gen_filelists ghc %{ghc_version_override} +%ghc_gen_filelists ghc-bignum %{ghc_bignum_ver} +%ghc_gen_filelists ghc-boot %{ghc_version_override} +%ghc_gen_filelists ghc-compact %{ghc_compact_ver} +%ghc_gen_filelists ghc-heap %{ghc_version_override} +%ghc_gen_filelists ghci %{ghc_version_override} +%ghc_gen_filelists hpc %{hpc_ver} + +%ghc_gen_filelists ghc-prim 0.11.0 +%ghc_gen_filelists integer-gmp 1.1 +%ghc_gen_filelists rts %{rts_ver} + +%define merge_filelist()\ +cat %{name}-%1.files >> %{name}-%2.files\ +cat %{name}-%1-devel.files >> %{name}-%2-devel.files\ +%if %{with haddock}\ +cat %{name}-%1-doc.files >> %{name}-%2-doc.files\ +%endif\ +%if %{with ghc_prof}\ +cat %{name}-%1-prof.files >> %{name}-%2-prof.files\ +%endif\ +if [ "%1" != "rts" ]; then\ +cp -p libraries/%1/LICENSE libraries/LICENSE.%1\ +echo "%%license libraries/LICENSE.%1" >> %{name}-%2.files\ +fi\ +%{nil} + +%merge_filelist ghc-prim base +%merge_filelist integer-gmp base +%merge_filelist rts base + +%if "%{?_ghcdynlibdir}" != "%_libdir" +echo "%{_sysconfdir}/ld.so.conf.d/%{name}.conf" >> %{name}-base.files +%endif + +# add rts libs +for i in %{buildroot}%{ghclibplatform}/libHSrts*ghc%{ghc_version}.so; do +if [ "$(basename $i)" != "libHSrts-%{rts_ver}-ghc%{ghc_version}.so" ]; then +echo $i >> %{name}-base.files +fi +done + +if [ -f %{buildroot}%{ghcliblib}/package.conf.d/system-cxx-std-lib-1.0.conf ]; then +ls -d %{buildroot}%{ghcliblib}/package.conf.d/system-cxx-std-lib-1.0.conf >> %{name}-base-devel.files +fi + +%if %{with ghc_prof} +ls %{buildroot}%{ghclibdir}/bin/ghc-iserv-prof* >> %{name}-base-prof.files +ls %{buildroot}%{ghcliblib}/bin/ghc-iserv-prof >> %{name}-base-prof.files +%endif + +sed -i -e "s|^%{buildroot}||g" %{name}-base*.files +sed -i -e "s|%{buildroot}||g" %{buildroot}%{_bindir}/* + +%if %{with haddock} +rm %{buildroot}%{_pkgdocdir}/archives/libraries.html.tar.xz +%endif + +mkdir -p %{buildroot}%{_mandir}/man1 +install -p -m 0644 %{SOURCE5} %{buildroot}%{_mandir}/man1/ghc-pkg.1 +install -p -m 0644 %{SOURCE6} %{buildroot}%{_mandir}/man1/haddock.1 +install -p -m 0644 %{SOURCE7} %{buildroot}%{_mandir}/man1/runghc.1 + +%if %{with manual} +rm %{buildroot}%{_pkgdocdir}/archives/Haddock.html.tar.xz +rm %{buildroot}%{_pkgdocdir}/archives/users_guide.html.tar.xz +mv %{buildroot}%{_mandir}/man1/ghc{,-%{ghc_major}}.1 +%endif + +%ifarch armv7hl +export RPM_BUILD_NCPUS=1 +%endif + +%if %{with build_hadrian} +mv %{buildroot}%{_bindir}/hadrian{,-%{ghc_major}} +%endif + +rm %{buildroot}%{ghcliblib}/package.conf.d/.stamp +rm %{buildroot}%{ghcliblib}/package.conf.d/*.conf.copy + +# https://gitlab.haskell.org/ghc/ghc/-/issues/24121 +rm %{buildroot}%{ghclibdir}/share/doc/%ghcplatform/*/LICENSE + +(cd %{buildroot}%{ghcliblib}/bin +for i in *; do +if [ -f %{buildroot}%{ghclibdir}/bin/$i ]; then +ln -sf ../../bin/$i +fi +done +) + +( +cd %{buildroot}%{_bindir} +for i in *; do + case $i in + *-%{version}) ;; + *) + if [ -f $i-%{version} ]; then + ln -s $i-%{version} $i-%{ghc_major} + fi + esac +done +) + + +%check +export LANG=C.utf8 +# stolen from ghc6/debian/rules: +export LD_LIBRARY_PATH=%{buildroot}%{ghclibplatform}: +GHC=%{buildroot}%{ghclibdir}/bin/ghc +# Do some very simple tests that the compiler actually works +rm -rf testghc +mkdir testghc +echo 'main = putStrLn "Foo"' > testghc/foo.hs +$GHC testghc/foo.hs -o testghc/foo +[ "$(testghc/foo)" = "Foo" ] +rm testghc/* +echo 'main = putStrLn "Foo"' > testghc/foo.hs +$GHC testghc/foo.hs -o testghc/foo -O2 +[ "$(testghc/foo)" = "Foo" ] +rm testghc/* +echo 'main = putStrLn "Foo"' > testghc/foo.hs +$GHC testghc/foo.hs -o testghc/foo -dynamic +[ "$(testghc/foo)" = "Foo" ] +rm testghc/* + +$GHC --info + +# check the ABI hashes +%if %{with abicheck} +if [ "%{version}" = "$(ghc-%{ghc_major} --numeric-version)" ]; then + echo "Checking package ABI hashes:" + for i in %{ghc_packages_list}; do + old=$(ghc-pkg-%{ghc_major} field $i id --simple-output || :) + if [ -n "$old" ]; then + new=$(/usr/lib/rpm/ghc-pkg-wrapper %{buildroot}%{ghclibdir} field $i id --simple-output) + if [ "$old" != "$new" ]; then + echo "ABI hash for $i changed!:" >&2 + echo " $old -> $new" >&2 + ghc_abi_hash_change=yes + else + echo "($old unchanged)" + fi + else + echo "($i not installed)" + fi + done + if [ "$ghc_abi_hash_change" = "yes" ]; then + echo "ghc ABI hash change: aborting build!" >&2 + exit 1 + fi +else + echo "ABI hash checks skipped: GHC changed from $(ghc-%{ghc_major} --numeric-version) to %{version}" +fi +%endif + +%if %{with testsuite} +make test +%endif + + +%if %{defined ghclibdir} +%if "%{?_ghcdynlibdir}" != "%_libdir" +%post base -p /sbin/ldconfig +%postun base -p /sbin/ldconfig +%endif + + +%transfiletriggerin compiler -- %{ghcliblib}/package.conf.d +%ghc_pkg_recache +%end + +%transfiletriggerpostun compiler -- %{ghcliblib}/package.conf.d +%ghc_pkg_recache +%end +%endif + + +%files + +%files compiler +%license LICENSE +%doc README.md +%{_bindir}/ghc-%{version} +%{_bindir}/ghc-pkg-%{version} +%{_bindir}/ghci-%{version} +%{_bindir}/hp2ps-ghc-%{version} +%{_bindir}/hpc-ghc-%{version} +%{_bindir}/hsc2hs-ghc-%{version} +%{_bindir}/runghc-%{version} +%{_bindir}/runhaskell-%{version} +%{_bindir}/ghc-%{ghc_major} +%{_bindir}/ghc-pkg-%{ghc_major} +%{_bindir}/ghci-%{ghc_major} +%{_bindir}/runghc-%{ghc_major} +%{_bindir}/runhaskell-%{ghc_major} +%dir %{ghclibdir}/bin +%{ghclibdir}/bin/ghc +%{ghclibdir}/bin/ghc-iserv +%{ghclibdir}/bin/ghc-iserv-dyn +%{ghclibdir}/bin/ghc-pkg +%{ghclibdir}/bin/hpc +%{ghclibdir}/bin/hsc2hs +%{ghclibdir}/bin/runghc +%{ghclibdir}/bin/hp2ps +%{ghclibdir}/bin/unlit +%{ghclibdir}/bin/ghc-%{version} +%{ghclibdir}/bin/ghc-iserv-ghc-%{version} +%{ghclibdir}/bin/ghc-iserv-dyn-ghc-%{version} +%{ghclibdir}/bin/ghc-pkg-%{version} +%{ghclibdir}/bin/haddock +%{ghclibdir}/bin/haddock-ghc-%{version} +%{ghclibdir}/bin/hp2ps-ghc-%{version} +%{ghclibdir}/bin/hpc-ghc-%{version} +%{ghclibdir}/bin/hsc2hs-ghc-%{version} +%{ghclibdir}/bin/runghc-%{version} +%{ghclibdir}/bin/runhaskell +%{ghclibdir}/bin/runhaskell-%{version} +%{ghclibdir}/bin/unlit-ghc-%{version} +%dir %{ghcliblib}/bin +%{ghcliblib}/bin/ghc-iserv +%{ghcliblib}/bin/ghc-iserv-dyn +%{ghcliblib}/bin/unlit +%{ghcliblib}/ghc-interp.js +%{ghcliblib}/ghc-usage.txt +%{ghcliblib}/ghci-usage.txt +%{ghcliblib}/llvm-passes +%{ghcliblib}/llvm-targets +%dir %{ghcliblib}/package.conf.d +%ghost %{ghcliblib}/package.conf.d/package.cache +%{ghcliblib}/package.conf.d/package.cache.lock +%{ghcliblib}/settings +%{ghcliblib}/template-hsc.h +%{_mandir}/man1/ghc-pkg.1* +%{_mandir}/man1/haddock.1* +%{_mandir}/man1/runghc.1* + +%{_bindir}/haddock-ghc-%{version} +%{ghcliblib}/html +%{ghcliblib}/latex +%if %{with haddock} || %{with manual} +%{ghc_html_libraries_dir}/prologue.txt +%endif +%if %{with haddock} +%verify(not size mtime) %{ghc_html_libraries_dir}/haddock-bundle.min.js +%verify(not size mtime) %{ghc_html_libraries_dir}/linuwial.css +%verify(not size mtime) %{ghc_html_libraries_dir}/quick-jump.css +%verify(not size mtime) %{ghc_html_libraries_dir}/synopsis.png +%endif +%if %{with manual} +%{_mandir}/man1/ghc-%{ghc_major}.1* +%endif + +%files compiler-default +%{_bindir}/ghc +%{_bindir}/ghc-pkg +%{_bindir}/ghci +%{_bindir}/haddock +%{_bindir}/hp2ps +%{_bindir}/hpc +%{_bindir}/hsc2hs +%{_bindir}/runghc +%{_bindir}/runhaskell + +%files devel + +%if %{with haddock} || %{with manual} +%files doc +%{ghc_html_dir}/index.html + +%files doc-index +%{ghc_html_libraries_dir}/gen_contents_index +%if %{with haddock} +%verify(not size mtime) %{ghc_html_libraries_dir}/doc-index*.html +%verify(not size mtime) %{ghc_html_libraries_dir}/index*.html +%endif + +%files filesystem +%dir %_ghc_doc_dir +%dir %ghc_html_dir +%dir %ghc_html_libraries_dir +%endif + +%if %{with build_hadrian} +%files hadrian +%license LICENSE.hadrian +%{_bindir}/hadrian-%{ghc_major} +%endif + +%if %{with manual} +%files manual +## needs pandoc +#%%{ghc_html_dir}/Cabal +%{ghc_html_dir}/index.html +%{ghc_html_dir}/users_guide +%{ghc_html_dir}/Haddock +%endif + +%if %{with ghc_prof} +%files prof +%endif + + +%changelog +* Thu Mar 14 2024 Jens Petersen - 9.10.0.20240313-0.2 +- update to 0.1.0.0 + +* Mon Feb 26 2024 Jens Petersen - 9.8.2-8 +- https://downloads.haskell.org/~ghc/9.8.2/docs/users_guide/9.8.2-notes.html +- minor bumps to bytestring, filepath, text, unix + +* Thu Feb 15 2024 Richard W.M. Jones - 9.8.1-7 +- Fix generated C for Modern C Initiative + +* Wed Jan 24 2024 Fedora Release Engineering - 9.8.1-6 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_40_Mass_Rebuild + +* Mon Jan 22 2024 Jens Petersen - 9.8.1-5 +- use gcc default ld (ie ld.bfd) for rawhide + +* Fri Jan 19 2024 Fedora Release Engineering - 9.8.1-4 +- Rebuilt for https://fedoraproject.org/wiki/Fedora_40_Mass_Rebuild + +* Fri Jan 5 2024 Jens Petersen - 9.8.1-3 +- fix llvm alignment in data sections (@stefansf (IBM)) + which should fix certain runtime crashes (#2248097) + +* Sun Nov 12 2023 Jens Petersen - 9.8.1-2 +- rebuild with ghc-rpm-macros-2.6.5 to fix prof deps (thanks mimi1vx) + +* Thu Oct 26 2023 Jens Petersen - 9.8.1-1 +- https://downloads.haskell.org/ghc/9.8.1/docs/users_guide/9.8.1-notes.html + +* Fri Aug 11 2023 Jens Petersen - 9.8.0.20230809-0.2 +- https://downloads.haskell.org/ghc/9.8.1-alpha2/docs/users_guide/9.8.1-notes.html + +* Fri Aug 4 2023 Jens Petersen - 9.8.0.20230727-0.1 +- initial package based on ghc9.6 diff --git a/haddock-remove-googleapis-fonts.patch b/haddock-remove-googleapis-fonts.patch new file mode 100644 index 0000000..1429063 --- /dev/null +++ b/haddock-remove-googleapis-fonts.patch @@ -0,0 +1,26 @@ +Description: Remove hard-coded googleapis font URL +Bug: https://github.com/haskell/haddock/issues/1211 +Bug-Debian: https://bugs.debian.org/963690 + +Index: b/utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs +=================================================================== +--- a/utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs ++++ b/utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs +@@ -137,7 +137,7 @@ headHtml docTitle themes mathjax_url bas + , thetype "text/css" + , href (withBaseURL base_url quickJumpCssFile) ] + << noHtml +- , thelink ! [ rel "stylesheet", thetype "text/css", href fontUrl] << noHtml ++ -- , thelink ! [ rel "stylesheet", thetype "text/css", href fontUrl] << noHtml + , script ! [ src (withBaseURL base_url haddockJsFile) + , emptyAttr "async" + , thetype "text/javascript" ] +@@ -146,7 +146,7 @@ headHtml docTitle themes mathjax_url bas + , script ! [src mjUrl, thetype "text/javascript"] << noHtml + ] + where +- fontUrl = "https://fonts.googleapis.com/css?family=PT+Sans:400,400i,700" ++ -- fontUrl = "https://fonts.googleapis.com/css?family=PT+Sans:400,400i,700" + mjUrl = fromMaybe "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.5/MathJax.js?config=TeX-AMS-MML_HTMLorMML" mathjax_url + mjConf = unwords [ "MathJax.Hub.Config({" + , "tex2jax: {" diff --git a/haddock.man b/haddock.man new file mode 100644 index 0000000..a30106b --- /dev/null +++ b/haddock.man @@ -0,0 +1,231 @@ +.TH HADDOCK 1 "July 2010" "Haddock, version 2.6.1" "Haddock documentation generator" + + +.SH NAME +haddock \- documentation tool for annotated Haskell source code + + +.SH SYNOPSIS +.B haddock +.RI [ options ] " file" ... + + +.SH DESCRIPTION +This manual page documents briefly the +.B haddock +command. +Extensive documentation is available in various other formats including DVI, +PostScript and HTML; see below. + +.PP +.I file +is a filename containing a Haskell source module. +All the modules specified on the command line will be processed together. +When one module refers to an entity in another module being processed, the +documentation will link directly to that entity. + +Entities that cannot be found, for example because they are in a module that +is not being processed as part of the current batch, simply will not be +hyperlinked in the generated documentation. +.B haddock +will emit warnings listing all the identifiers it could not resolve. + +The modules should not be mutually recursive, as +.B haddock +does not like swimming in circles. + + +.SH OPTIONS +The programs follow the usual GNU command line syntax, with long +options starting with two dashes (`--'). +A summary of options is included below. +For a complete description, see the other documentation. + +.TP +\fB\-o \fIDIR\fP, \-\-odir=\fIDIR\fP +directory in which to put the output files + +.TP +\fB\-i \fIFILE\fP, \-\-read-interface=\fIFILE\fP +read an interface from +.IR FILE . + +.TP +\fB\-D \fIFILE\fP, \-\-dump\-interface=\fIFILE\fP +dump an interface for these modules in +.IR FILE . + +.TP +\fB\-l \fIDIR\fP, \-\-lib=\fIDIR\fP +location of Haddock's auxiliary files + +.TP +.BR \-h ", " \-\-html +Generate documentation in HTML format. +Several files will be generated into the current directory (or the specified +directory if the +.B \-o +option is given), including the following: +.RS +.TP +.I index.html +The top level page of the documentation: +lists the modules available, using indentation to represent the hierarchy if +the modules are hierarchical. +.TP +.I haddock.css +The stylesheet used by the generated HTML. +Feel free to modify this to change the colors or layout, or even specify +your own stylesheet using the +.B \-\-css +option. +.TP +.I module.html +An HTML page for each module. +.TP +.IR doc-index.html ", " doc-index-XX.html +The index, split into two (functions/constructors and types/classes, as per +Haskell namespaces) and further split alphabetically. +.RE + +.TP +.B \-\-hoogle +output for Hoogle + +.TP +\fB\-\-html\-help=\fIformat +produce index and table of contents in mshelp, mshelp2 or devhelp format +(with \fI\-h\fP) + +.TP +\fB\-\-source\-base=\fPURL +Include links to the source files in the generated documentation, where URL +is the base URL where the source files can be found. + +.TP +\fB\-s \fPURL, \fB\-\-source\-module=\fPURL +Include links to the source files in the generated documentation, where URL +is a source code link for each module (using the %{FILE} or %{MODULE} vars). + +.TP +\fB\-\-source\-entity=\fPURL +Include links to the source files in the generated documentation, where URL +is a source code link for each entity (using the %{FILE}, %{MODULE} or %{NAME} vars). + +.TP +\fB\-\-comments\-base=\fPURL +URL for a comments link on the contents and index pages. +.TP +\fB\-\-comments\-module=\fPURL +URL for a comments link for each module (using the %{MODULE} var). +.TP +\fB\-\-comments\-entity=\fPURL +URL for a comments link for each entity (using the %{FILE}, %{MODULE} or %{NAME} vars). +.TP +.BI \-\-css= FILE +Use the CSS +.I FILE +instead of the default stylesheet that comes with +.B haddock +for HTML output. It should specify certain classes: see the default stylesheet for details. + +.TP +\fB\-p \fIFILE\fP, \-\-prologue=\fIFILE\fP +Specify a file containing prologue text. + +.TP +\fB\-t \fITITLE\fP, \-\-title=\fITITLE\fP +Use \fITITLE\fP as the page heading for each page in the documentation. +This will normally be the name of the library being documented. + +The title should be a plain string (no markup please!). + +.TP +\fB\-k \fINAME\fP, \-\-package=\fINAME\fP +Specify the package name (optional). + +.TP +.BR \-n ", " \-\-no\-implicit\-prelude +do not assume Prelude is imported + +.TP +.BR \-d ", " \-\-debug +Enable extra debugging output. + +.TP +.BR \-? ", " \-\-help +Display help. + +.TP +.BR \-V ", " \-\-version +Display version. + +.TP +.BR \-v ", " \-\-verbose +Verbose status reporting. + +.TP +\fB\-\-use\-contents=\fPURL +Use a separately-generated HTML contents page. + +.TP +.B \-\-gen\-contents +Generate an HTML contents from specified interfaces. + +.TP +\fB\-\-use\-index=\fPURL +Use a separately-generated HTML index. + +.TP +.B \-\-gen\-index +Generate an HTML index from specified interfaces. + +.TP +.B \-\-ignore\-all\-exports +Behave as if all modules have the ignore-exports atribute + +.TP +\fB\-\-hide=\fIMODULE +Behave as if \fIMODULE\fP has the hide attribute. + +.TP +\fB\-\-use\-package=\fIPACKAGE +The modules being processed depend on \fIPACKAGE\fP. + +.SH FILES +.I /usr/bin/haddock +.br +.I /usr/share/haddock-2.6.1/html/plus.gif +.br +.I /usr/share/haddock-2.6.1/html/minus.gif +.br +.I /usr/share/haddock-2.6.1/html/haskell_icon.gif +.br +.I /usr/share/haddock-2.6.1/html/haddock.js +.br +.I /usr/share/haddock-2.6.1/html/haddock.css +.br +.I /usr/share/haddock-2.6.1/html/haddock-DEBUG.css + +.SH SEE ALSO +.IR /usr/share/doc/haddock/ , +.br +the Haddock homepage +.UR http://haskell.org/haddock/ +(http://haskell.org/haddock/) +.UE + +.SH COPYRIGHT +Haddock version 2.6.1 + +Copyright 2006-2010 Simon Marlow , Dawid Waern . +All rights reserved. + + +.SH AUTHOR +This manual page was written by Michael Weber +for the Debian GNU/Linux system (but may be used by others). + +.\" Local variables: +.\" mode: nroff +.\" End: diff --git a/libraries-versions.sh b/libraries-versions.sh new file mode 100755 index 0000000..fccce7a --- /dev/null +++ b/libraries-versions.sh @@ -0,0 +1,11 @@ +#!/bin/sh + +if [ ! -d libraries ]; then + echo Is CWD a ghc source tree? + exit 1 +fi + +cd libraries + +# should handle ../rts/rts.cabal.in +grep -i ^version: $(find * -name "*.cabal*" | LANG=C.utf8 sort) ../rts/rts.cabal.in | grep -v -e "\(Win32\|cabal-\|gmp.old\|gmp2\|integer-simple\|tests\|bench\)" -e "@ProjectVersionMunged@" | grep -e '[0-9]\.' | sed -e "s!.*/\([^/]*\).cabal:[Vv]ersion: \+!\1-!" diff --git a/no-missing-haddock-file-warning.patch b/no-missing-haddock-file-warning.patch new file mode 100644 index 0000000..eac921e --- /dev/null +++ b/no-missing-haddock-file-warning.patch @@ -0,0 +1,22 @@ +Description: Do not emit a warning if the .haddock file is missing + As it is quite common on Debian installations to install the -dev package + without the -doc package. +Author: Joachim Breitner + +Index: ghc-8.0.2/utils/ghc-pkg/Main.hs +=================================================================== +--- ghc-8.0.2.orig/utils/ghc-pkg/Main.hs ++++ ghc-8.0.2/utils/ghc-pkg/Main.hs +@@ -1588,8 +1588,10 @@ + mapM_ (checkDir True "dynamic-library-dirs") (libraryDynDirs pkg) + mapM_ (checkDir True "include-dirs") (includeDirs pkg) + mapM_ (checkDir True "framework-dirs") (frameworkDirs pkg) +- mapM_ (checkFile True "haddock-interfaces") (haddockInterfaces pkg) +- mapM_ (checkDirURL True "haddock-html") (haddockHTMLs pkg) ++ -- In Debian, it is quite normal that the package is installed without the ++ -- documentation. Do not print a warning there. ++ -- mapM_ (checkFile True "haddock-interfaces") (haddockInterfaces pkg) ++ -- mapM_ (checkDirURL True "haddock-html") (haddockHTMLs pkg) + checkDuplicateModules pkg + checkExposedModules db_stack pkg + checkOtherModules pkg diff --git a/runghc.man b/runghc.man new file mode 100644 index 0000000..61a9076 --- /dev/null +++ b/runghc.man @@ -0,0 +1,45 @@ +.TH RUNGHC 1 "28 NOVEMBER 2007" +.SH NAME +runghc \- program to run Haskell programs without first having to compile them. +.SH SYNOPSIS +.B runghc +.RI +[runghc|flags] [GHC|flags] module [program|flags]... +.br +.SH DESCRIPTION +.B runghc +is considered a non-interactive interpreter and part of The Glasgow Haskell Compiler. +.B runghc +is a compiler that automatically runs its results at the end. +.PP +.SH OPTIONS +.TP +the flags are: +.TP +.B \-f +it tells runghc which GHC to use to run the program. If it is not given then runghc will search for GHC in the directories in the system search path. runghc -f /path/to/ghc +.TP +.B \-- +runghc will try to work out where the boundaries between [runghc flags] and [GHC flags], and [GHC flags] and module are, but you can use a -- flag if it doesn't get it right. For example, runghc -- -fglasgow-exts Foo +means runghc won't try to use glasgow-exts as the path to GHC, but instead will pass the flag to GHC. + +.SH EXAMPLES +.TP +.B runghc foo +.PP +.B runghc -f /path/to/ghc foo +.TP +.B runghc -- -fglasgow-exts Foo + +.SH SEE ALSO +.BR ghc (1), +.BR ghci (1). +.br + +.SH COPYRIGHT +Copyright 2002, The University Court of the University of Glasgow. All rights reserved. + +.SH AUTHOR +This manual page was written by Efrain Valles Pulgar . This is free documentation; see the GNU +General Public Licence version 2 or later for copying conditions. There is NO WARRANTY. + diff --git a/sources b/sources new file mode 100644 index 0000000..b578a7d --- /dev/null +++ b/sources @@ -0,0 +1 @@ +SHA512 (ghc-9.10.0.20240313-src.tar.xz) = cea3a7c47586efd66b3396906812a8dfc876dcaa89c735ff2d2e7527d8b88b459a9591ec26c6d98ffaa2ff0fa8d76047bf9b8f22d918f798f3eda6a806c0202b diff --git a/text2-allow-ghc8-arm.patch b/text2-allow-ghc8-arm.patch new file mode 100644 index 0000000..e4009a8 --- /dev/null +++ b/text2-allow-ghc8-arm.patch @@ -0,0 +1,12 @@ +--- ghc-9.4.0.20220501/libraries/text/text.cabal~ 2022-04-30 02:50:06.000000000 +0800 ++++ ghc-9.4.0.20220501/libraries/text/text.cabal 2022-05-06 23:55:56.091521266 +0800 +@@ -121,9 +121,6 @@ + if os(windows) && impl(ghc >= 8.2 && < 8.4 || == 8.6.3 || == 8.10.1) + build-depends: base < 0 + +- -- GHC 8.10 has linking issues (probably TH-related) on ARM. +- if (arch(aarch64) || arch(arm)) && impl(ghc == 8.10.*) +- build-depends: base < 0 + + -- Subword primitives in GHC 9.2.1 are broken on ARM platforms. + if (arch(aarch64) || arch(arm)) && impl(ghc == 9.2.1)