[Git][ghc/ghc][wip/T24471] 8 commits: rel_eng: Update hackage docs upload scripts
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Tue Mar 5 22:00:36 UTC 2024
Simon Peyton Jones pushed to branch wip/T24471 at Glasgow Haskell Compiler / GHC
Commits:
18ad1077 by Matthew Pickering at 2024-03-05T14:22:31-05:00
rel_eng: Update hackage docs upload scripts
This adds the upload of ghc-internal and ghc-experimental to our scripts
which upload packages to hackage.
- - - - -
bf47c9ba by Matthew Pickering at 2024-03-05T14:22:31-05:00
docs: Remove stray module comment from GHC.Profiling.Eras
- - - - -
37d9b340 by Matthew Pickering at 2024-03-05T14:22:31-05:00
Fix ghc-internal cabal file
The file mentioned some artifacts relating to the base library. I have
renamed these to the new ghc-internal variants.
- - - - -
23f2a478 by Matthew Pickering at 2024-03-05T14:22:31-05:00
Fix haddock source links and hyperlinked source
There were a few issues with the hackage links:
1. We were using the package id rather than the package name for the
package links. This is fixed by now allowing the template to mention
%pkg% or %pkgid% and substituing both appropiatly.
2. The `--haddock-base-url` flag is renamed to `--haddock-for-hackage`
as the new base link works on a local or remote hackage server.
3. The "src" path including too much stuff, so cross-package source
links were broken as the template was getting double expanded.
Fixes #24086
- - - - -
2fa336a9 by Ben Gamari at 2024-03-05T14:23:07-05:00
filepath: Bump submodule to 1.5.2.0
- - - - -
31217944 by Ben Gamari at 2024-03-05T14:23:07-05:00
os-string: Bump submodule to 2.0.2
- - - - -
7841fb71 by Ben Gamari at 2024-03-05T22:00:21+00:00
ghc-experimental: Add dummy dependencies to work around #24436
This is a temporary measure to improve CI reliability until a proper
solution is developed.
- - - - -
5c227bca by Simon Peyton Jones at 2024-03-05T22:00:21+00:00
Three compile perf improvements with deep nesting
These were changes are all triggered by #24471.
1. Make GHC.Core.Opt.SetLevels.lvlMFE behave better when there are
many free variables. See Note [Large free-variable sets].
2. Make GHC.Core.Opt.Arity.floatIn a bit lazier in its Cost argument.
This benefits the common case where the ArityType turns out to
be nullary. See Note [Care with nested expressions]
3. Make GHC.CoreToStg.Prep.cpeArg behave for deeply-nested
expressions. See Note [Eta expansion of arguments in CorePrep]
wrinkle (EA2).
Compile times go down by up to 4.5%, and much more in artificial
cases. (Geo mean of compiler/perf changes is -0.4%.)
Metric Decrease:
CoOpt_Read
T10421
T12425
- - - - -
18 changed files:
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- .gitlab/rel_eng/upload_ghc_libs.py
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/CoreToStg/Prep.hs
- hadrian/README.md
- hadrian/src/CommandLine.hs
- hadrian/src/Settings/Builders/Haddock.hs
- libraries/filepath
- libraries/ghc-experimental/src/Data/Sum/Experimental.hs
- libraries/ghc-experimental/src/Data/Tuple/Experimental.hs
- libraries/ghc-experimental/src/GHC/Profiling/Eras.hs
- libraries/ghc-internal/ghc-internal.cabal
- libraries/os-string
- + testsuite/tests/perf/compiler/T24471.hs
- + testsuite/tests/perf/compiler/T24471a.hs
- testsuite/tests/perf/compiler/all.T
Changes:
=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -1031,7 +1031,7 @@ job_groups =
-- (see Note [Object unloading]).
fullyStaticBrokenTests = modifyJobs (addVariable "BROKEN_TESTS" "ghcilink002 linker_unload_native")
- hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-base-url")
+ hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-for-hackage")
tsan_jobs =
modifyJobs
=====================================
.gitlab/jobs.yaml
=====================================
@@ -2330,7 +2330,7 @@
"BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release",
"BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "HADRIAN_ARGS": "--haddock-base-url",
+ "HADRIAN_ARGS": "--haddock-for-hackage",
"LLC": "/bin/false",
"OPT": "/bin/false",
"RUNTEST_ARGS": "",
@@ -4007,7 +4007,7 @@
"BIN_DIST_NAME": "ghc-x86_64-linux-fedora33-release",
"BUILD_FLAVOUR": "release",
"CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
- "HADRIAN_ARGS": "--haddock-base-url --hash-unit-ids",
+ "HADRIAN_ARGS": "--haddock-for-hackage --hash-unit-ids",
"IGNORE_PERF_FAILURES": "all",
"LLC": "/bin/false",
"OPT": "/bin/false",
=====================================
.gitlab/rel_eng/upload_ghc_libs.py
=====================================
@@ -49,6 +49,10 @@ def prep_base():
shutil.copy('config.guess', 'libraries/base')
shutil.copy('config.sub', 'libraries/base')
+def prep_ghc_internal():
+ shutil.copy('config.guess', 'libraries/ghc-internal')
+ shutil.copy('config.sub', 'libraries/ghc-internal')
+
def build_copy_file(pkg: Package, f: Path):
target = Path('_build') / 'stage1' / pkg.path / 'build' / f
dest = pkg.path / f
@@ -93,6 +97,8 @@ PACKAGES = {
pkg.name: pkg
for pkg in [
Package('base', Path("libraries/base"), prep_base),
+ Package('ghc-internal', Path("libraries/ghc-internal"), prep_ghc_internal),
+ Package('ghc-experimental', Path("libraries/ghc-experimental"), no_prep),
Package('ghc-prim', Path("libraries/ghc-prim"), prep_ghc_prim),
Package('integer-gmp', Path("libraries/integer-gmp"), no_prep),
Package('ghc-bignum', Path("libraries/ghc-bignum"), prep_ghc_bignum),
=====================================
compiler/GHC/Core/Opt/Arity.hs
=====================================
@@ -1270,8 +1270,14 @@ arityLam id (AT oss div)
floatIn :: Cost -> ArityType -> ArityType
-- We have something like (let x = E in b),
-- where b has the given arity type.
-floatIn IsCheap at = at
-floatIn IsExpensive at = addWork at
+-- NB: be as lazy as possible in the Cost-of-E argument;
+-- we can often get away without ever looking at it
+-- See Note [Care with nested expressions]
+floatIn ch at@(AT lams div)
+ = case lams of
+ [] -> at
+ (IsExpensive,_):_ -> at
+ (_,os):lams -> AT ((ch,os):lams) div
addWork :: ArityType -> ArityType
-- Add work to the outermost level of the arity type
@@ -1354,6 +1360,25 @@ That gives \1.T (see Note [Combining case branches: andWithTail],
first bullet). So 'go2' gets an arityType of \(C?)(C1).T, which is
what we want.
+Note [Care with nested expressions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+ arityType (Just <big-expressions>)
+We will take
+ arityType Just = AT [(IsCheap,os)] topDiv
+and then do
+ arityApp (AT [(IsCheap os)] topDiv) (exprCost <big-expression>)
+The result will be AT [] topDiv. It doesn't matter what <big-expresison>
+is! The same is true of
+ arityType (let x = <rhs> in <body>)
+where the cost of <rhs> doesn't matter unless <body> has a useful
+arityType.
+
+TL;DR in `floatIn`, do not to look at the Cost argument until you have to.
+
+I found this when looking at #24471, although I don't think it was really
+the main culprit.
+
Note [Combining case branches: andWithTail]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When combining the ArityTypes for two case branches (with andArityType)
@@ -1576,7 +1601,7 @@ arityType env (Case scrut bndr _ alts)
= alts_type
| otherwise -- In the remaining cases we may not push
- = addWork alts_type -- evaluation of the scrutinee in
+ = addWork alts_type -- evaluation of the scrutinee in
where
env' = delInScope env bndr
arity_type_alt (Alt _con bndrs rhs) = arityType (delInScopeList env' bndrs) rhs
=====================================
compiler/GHC/Core/Opt/SetLevels.hs
=====================================
@@ -643,7 +643,8 @@ lvlMFE env strict_ctxt e@(_, AnnCase {})
= lvlExpr env e -- See Note [Case MFEs]
lvlMFE env strict_ctxt ann_expr
- | floatTopLvlOnly env && not (isTopLvl dest_lvl)
+ | not float_me
+ || floatTopLvlOnly env && not (isTopLvl dest_lvl)
-- Only floating to the top level is allowed.
|| hasFreeJoin env fvs -- If there is a free join, don't float
-- See Note [Free join points]
@@ -652,8 +653,9 @@ lvlMFE env strict_ctxt ann_expr
-- how it will be represented at runtime.
-- See Note [Representation polymorphism invariants] in GHC.Core
|| notWorthFloating expr abs_vars
- || not float_me
- = -- Don't float it out
+ -- Test notWorhtFloating last;
+ -- See Note [Large free-variable sets]
+ = -- Don't float it out
lvlExpr env ann_expr
| float_is_new_lam || exprIsTopLevelBindable expr expr_ty
@@ -822,6 +824,28 @@ early loses opportunities for RULES which (needless to say) are
important in some nofib programs (gcd is an example). [SPJ note:
I think this is obsolete; the flag seems always on.]
+Note [Large free-variable sets]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In #24471 we had something like
+ x1 = I# 1
+ ...
+ x1000 = I# 1000
+ foo = f x1 (f x2 (f x3 ....))
+So every sub-expression in `foo` has lots and lots of free variables. But
+none of these sub-expressions float anywhere; the entire float-out pass is a
+no-op.
+
+In lvlMFE, we want to find out quickly if the MFE is not-floatable; that is
+the common case. In #24471 it turned out that we were testing `abs_vars` (a
+relatively complicated calculation that takes at least O(n-free-vars) time to
+compute) for every sub-expression.
+
+Better instead to test `float_me` early. That still involves looking at
+dest_lvl, which means looking at every free variable, but the constant factor
+is a lot better.
+
+ToDo: find a way to fix the bad asymptotic complexity.
+
Note [Floating join point bindings]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Mostly we only float a join point if it can /stay/ a join point. But
=====================================
compiler/GHC/CoreToStg/Prep.hs
=====================================
@@ -1469,8 +1469,7 @@ cpeArg env dmd arg
= do { (floats1, arg1) <- cpeRhsE env arg -- arg1 can be a lambda
; let arg_ty = exprType arg1
is_unlifted = isUnliftedType arg_ty
- dec = wantFloatLocal NonRecursive dmd is_unlifted
- floats1 arg1
+ dec = wantFloatLocal NonRecursive dmd is_unlifted floats1 arg1
; (floats2, arg2) <- executeFloatDecision dec floats1 arg1
-- Else case: arg1 might have lambdas, and we can't
-- put them inside a wrapBinds
@@ -1482,23 +1481,29 @@ cpeArg env dmd arg
then return (floats2, arg2)
else do { v <- newVar arg_ty
-- See Note [Eta expansion of arguments in CorePrep]
- ; let arg3 = cpeEtaExpandArg env arg2
+ ; let arity = cpeArgArity env dec arg2
+ arg3 = cpeEtaExpand arity arg2
arg_float = mkNonRecFloat env dmd is_unlifted v arg3
; return (snocFloat floats2 arg_float, varToCoreExpr v) }
}
-cpeEtaExpandArg :: CorePrepEnv -> CoreArg -> CoreArg
+cpeArgArity :: CorePrepEnv -> FloatDecision -> CoreArg -> Arity
-- ^ See Note [Eta expansion of arguments in CorePrep]
-cpeEtaExpandArg env arg = cpeEtaExpand arity arg
- where
- arity | Just ao <- cp_arityOpts (cpe_config env) -- Just <=> -O1 or -O2
- , not (has_join_in_tail_context arg)
+-- Returning 0 means "no eta-expansion"; see cpeEtaExpand
+cpeArgArity env float_decision arg
+ | FloatNone <- float_decision
+ = 0 -- Crucial short-cut
+ -- See wrinkle (EA2) in Note [Eta expansion of arguments in CorePrep]
+
+ | Just ao <- cp_arityOpts (cpe_config env) -- Just <=> -O1 or -O2
+ , not (has_join_in_tail_context arg)
-- See Wrinkle (EA1) of Note [Eta expansion of arguments in CorePrep]
- = case exprEtaExpandArity ao arg of
- Nothing -> 0
- Just at -> arityTypeArity at
- | otherwise
- = exprArity arg -- this is cheap enough for -O0
+ = case exprEtaExpandArity ao arg of
+ Nothing -> 0
+ Just at -> arityTypeArity at
+
+ | otherwise
+ = exprArity arg -- this is cheap enough for -O0
has_join_in_tail_context :: CoreExpr -> Bool
-- ^ Identify the cases where we'd generate invalid `CpeApp`s as described in
@@ -1510,34 +1515,10 @@ has_join_in_tail_context (Tick _ e) = has_join_in_tail_context e
has_join_in_tail_context (Case _ _ _ alts) = any has_join_in_tail_context (rhssOfAlts alts)
has_join_in_tail_context _ = False
-{-
-Note [Eta expansion of arguments with join heads]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-See Note [Eta expansion for join points] in GHC.Core.Opt.Arity
-Eta expanding the join point would introduce crap that we can't
-generate code for
-
-------------------------------------------------------------------------------
--- Building the saturated syntax
--- ---------------------------------------------------------------------------
-
-Note [Eta expansion of hasNoBinding things in CorePrep]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-maybeSaturate deals with eta expanding to saturate things that can't deal with
-unsaturated applications (identified by 'hasNoBinding', currently
-foreign calls, unboxed tuple/sum constructors, and representation-polymorphic
-primitives such as 'coerce' and 'unsafeCoerce#').
-
-Historical Note: Note that eta expansion in CorePrep used to be very fragile
-due to the "prediction" of CAFfyness that we used to make during tidying.
-We previously saturated primop
-applications here as well but due to this fragility (see #16846) we now deal
-with this another way, as described in Note [Primop wrappers] in GHC.Builtin.PrimOps.
--}
-
maybeSaturate :: Id -> CpeApp -> Int -> [CoreTickish] -> UniqSM CpeRhs
maybeSaturate fn expr n_args unsat_ticks
| hasNoBinding fn -- There's no binding
+ -- See Note [Eta expansion of hasNoBinding things in CorePrep]
= return $ wrapLamBody (\body -> foldr mkTick body unsat_ticks) sat_expr
| mark_arity > 0 -- A call-by-value function. See Note [CBV Function Ids]
@@ -1567,24 +1548,14 @@ maybeSaturate fn expr n_args unsat_ticks
fn_arity = idArity fn
excess_arity = (max fn_arity mark_arity) - n_args
sat_expr = cpeEtaExpand excess_arity expr
- applied_marks = n_args >= (length . dropWhile (not . isMarkedCbv) . reverse . expectJust "maybeSaturate" $ (idCbvMarks_maybe fn))
+ applied_marks = n_args >= (length . dropWhile (not . isMarkedCbv) .
+ reverse . expectJust "maybeSaturate" $ (idCbvMarks_maybe fn))
-- For join points we never eta-expand (See Note [Do not eta-expand join points])
- -- so we assert all arguments that need to be passed cbv are visible so that the backend can evalaute them if required..
-{-
-************************************************************************
-* *
- Simple GHC.Core operations
-* *
-************************************************************************
--}
+ -- so we assert all arguments that need to be passed cbv are visible so that the
+ -- backend can evalaute them if required..
-{-
--- -----------------------------------------------------------------------------
--- Eta reduction
--- -----------------------------------------------------------------------------
-
-Note [Eta expansion]
-~~~~~~~~~~~~~~~~~~~~~
+{- Note [Eta expansion]
+~~~~~~~~~~~~~~~~~~~~~~~
Eta expand to match the arity claimed by the binder Remember,
CorePrep must not change arity
@@ -1603,6 +1574,19 @@ NB2: we have to be careful that the result of etaExpand doesn't
an SCC note - we're now careful in etaExpand to make sure the
SCC is pushed inside any new lambdas that are generated.
+Note [Eta expansion of hasNoBinding things in CorePrep]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+maybeSaturate deals with eta expanding to saturate things that can't deal
+with unsaturated applications (identified by 'hasNoBinding', currently
+foreign calls, unboxed tuple/sum constructors, and representation-polymorphic
+primitives such as 'coerce' and 'unsafeCoerce#').
+
+Historical Note: Note that eta expansion in CorePrep used to be very fragile
+due to the "prediction" of CAFfyness that we used to make during tidying. We
+previously saturated primop applications here as well but due to this
+fragility (see #16846) we now deal with this another way, as described in
+Note [Primop wrappers] in GHC.Builtin.PrimOps.
+
Note [Eta expansion and the CorePrep invariants]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It turns out to be much much easier to do eta expansion
@@ -1685,6 +1669,22 @@ There is a nasty Wrinkle:
This scenario occurs rarely; hence it's OK to generate sub-optimal code.
The alternative would be to fix Note [Eta expansion for join points], but
that's quite challenging due to unfoldings of (recursive) join points.
+
+(EA2) In cpeArgArity, if float_decision = FloatNone) the `arg` will look like
+ let <binds> in rhs
+ where <binds> is non-empty and can't be floated out of a lazy context (see
+ `wantFloatLocal`). So we can't eta-expand it anyway, so we can return 0
+ forthwith. Without this short-cut we will call exprEtaExpandArity on the
+ `arg`, and <binds> might be enormous. exprEtaExpandArity be very expensive
+ on this: it uses arityType, and may look at <binds>.
+
+ On the other hand, if float_decision = FloatAll, there will be no
+ let-bindings around 'arg'; they will have floated out. So
+ exprEtaExpandArity is cheap.
+
+ This can make a huge difference on deeply nested expressions like
+ f (f (f (f (f ...))))
+ #24471 is a good example, where Prep took 25% of compile time!
-}
cpeEtaExpand :: Arity -> CpeRhs -> CpeRhs
@@ -1899,7 +1899,7 @@ instance Outputable FloatInfo where
-- See Note [Floating in CorePrep]
-- and Note [BindInfo and FloatInfo]
data FloatingBind
- = Float !CoreBind !BindInfo !FloatInfo
+ = Float !CoreBind !BindInfo !FloatInfo -- Never a join-point binding
| UnsafeEqualityCase !CoreExpr !CoreBndr !AltCon ![CoreBndr]
| FloatTick CoreTickish
@@ -2126,19 +2126,16 @@ data FloatDecision
| FloatAll
executeFloatDecision :: FloatDecision -> Floats -> CpeRhs -> UniqSM (Floats, CpeRhs)
-executeFloatDecision dec floats rhs = do
- let (float,stay) = case dec of
- _ | isEmptyFloats floats -> (emptyFloats,emptyFloats)
- FloatNone -> (emptyFloats, floats)
- FloatAll -> (floats, emptyFloats)
- -- Wrap `stay` around `rhs`.
- -- NB: `rhs` might have lambdas, and we can't
- -- put them inside a wrapBinds, which expects a `CpeBody`.
- if isEmptyFloats stay -- Fast path where we don't need to call `rhsToBody`
- then return (float, rhs)
- else do
- (floats', body) <- rhsToBody rhs
- return (float, wrapBinds stay $ wrapBinds floats' body)
+executeFloatDecision dec floats rhs
+ = case dec of
+ FloatAll -> return (floats, rhs)
+ FloatNone
+ | isEmptyFloats floats -> return (emptyFloats, rhs)
+ | otherwise -> do { (floats', body) <- rhsToBody rhs
+ ; return (emptyFloats, wrapBinds floats $
+ wrapBinds floats' body) }
+ -- FloatNone case: `rhs` might have lambdas, and we can't
+ -- put them inside a wrapBinds, which expects a `CpeBody`.
wantFloatTop :: Floats -> FloatDecision
wantFloatTop fs
=====================================
hadrian/README.md
=====================================
@@ -306,9 +306,9 @@ all of the documentation targets:
You can pass several `--docs=...` flags, Hadrian will combine
their effects.
-To build haddock documentation for upload to hackage you need to pass the `--haddock-base-url` flag,
-by default this will choose a url suitable for uploading to hackage but you might also want to pass something like
-`http://127.0.0.1:8080/package/%pkg%/docs` for testing upload locally on a local hackage server.
+To build haddock documentation for upload to hackage you need to pass the `--haddock-for-hackage` flag,
+This will generate URLs which are appropiate for either uploading to a local hackage
+server or the global hackage server.
#### Source distribution
=====================================
hadrian/src/CommandLine.hs
=====================================
@@ -17,7 +17,6 @@ import System.Environment
import qualified System.Directory as Directory
import qualified Data.Set as Set
-import Data.Maybe
data TestSpeed = TestSlow | TestNormal | TestFast deriving (Show, Eq)
@@ -114,7 +113,7 @@ data DocArgs = DocArgs
} deriving (Eq, Show)
defaultDocArgs :: DocArgs
-defaultDocArgs = DocArgs { docsBaseUrl = "../%pkg%" }
+defaultDocArgs = DocArgs { docsBaseUrl = "../%pkgid%" }
readConfigure :: Either String (CommandLineArgs -> CommandLineArgs)
readConfigure = Left "hadrian --configure has been deprecated (see #20167). Please run ./boot; ./configure manually"
@@ -192,11 +191,11 @@ readTestOnlyPerf = Right $ \flags -> flags { testArgs = (testArgs flags) { testO
readTestSkipPerf :: Either String (CommandLineArgs -> CommandLineArgs)
readTestSkipPerf = Right $ \flags -> flags { testArgs = (testArgs flags) { testSkipPerf = True } }
-readHaddockBaseUrl :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
-readHaddockBaseUrl base_url = Right $ \flags ->
- flags { docsArgs = (docsArgs flags) { docsBaseUrl = base_url' } }
+readHaddockBaseUrl :: Either String (CommandLineArgs -> CommandLineArgs)
+readHaddockBaseUrl = Right $ \flags ->
+ flags { docsArgs = (docsArgs flags) { docsBaseUrl = base_url } }
- where base_url' = fromMaybe "https://hackage.haskell.org/package/%pkg%/docs" base_url
+ where base_url = "/package/%pkg%/docs"
readTestRootDirs :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
@@ -320,8 +319,8 @@ optDescrs =
"Destination path for the bindist 'install' rule"
, Option [] ["complete-setting"] (OptArg readCompleteStg "SETTING")
"Setting key to autocomplete, for the 'autocomplete' target."
- , Option [] ["haddock-base-url"] (OptArg readHaddockBaseUrl "BASE_URL")
- "Generate documentation suitable for upload to hackage or for another base URL (for example a local hackage server)."
+ , Option [] ["haddock-for-hackage"] (NoArg readHaddockBaseUrl)
+ "Generate documentation suitable for upload to a hackage server."
]
-- | A type-indexed map containing Hadrian command line arguments to be passed
=====================================
hadrian/src/Settings/Builders/Haddock.hs
=====================================
@@ -43,12 +43,15 @@ haddockBuilderArgs = mconcat
version <- expr $ pkgVersion pkg
synopsis <- expr $ pkgSynopsis pkg
haddocks <- expr $ haddockDependencies context
- haddocks_with_versions <- expr $ sequence $ [(,h) <$> pkgUnitId stage p | (p, h) <- haddocks]
+ haddocks_with_versions <- expr $ sequence $ [(,,h) <$> pkgSimpleIdentifier p <*> pkgUnitId stage p | (p, h) <- haddocks]
hVersion <- expr $ pkgVersion haddock
statsDir <- expr $ haddockStatsFilesDir
baseUrlTemplate <- expr (docsBaseUrl <$> userSetting defaultDocArgs)
- let baseUrl p = substituteTemplate baseUrlTemplate p
+ -- The path to where the docs for a package are
+ let docpath p = substituteTemplate baseUrlTemplate p
+ -- The path to where the src folder is for a package (typically docs ++ "/src/")
+ let srcpath p = docpath p ++ "/src/"
ghcOpts <- haddockGhcArgs
-- These are the options which are necessary to perform the build. Additional
-- options such as `--hyperlinked-source`, `--hoogle`, `--quickjump` are
@@ -67,14 +70,18 @@ haddockBuilderArgs = mconcat
, arg $ "--optghc=-D__HADDOCK_VERSION__="
++ show (versionToInt hVersion)
, map ("--hide=" ++) <$> getContextData otherModules
- , pure [ "--read-interface=../" ++ p
- ++ "," ++ baseUrl p ++ "/src/%{MODULE}.html#%{NAME},"
- ++ haddock | (p, haddock) <- haddocks_with_versions ]
+ , pure [ "--read-interface=" ++ docpath (p, pid)
+ ++ "," ++ srcpath (p, pid) ++ ","
+ ++ haddock | (p, pid, haddock) <- haddocks_with_versions ]
, pure [ "--optghc=" ++ opt | opt <- ghcOpts, not ("--package-db" `isInfixOf` opt) ]
, arg "+RTS"
, arg $ "-t" ++ (statsDir -/- pkgName pkg ++ ".t")
, arg "--machine-readable"
, arg "-RTS" ] ]
-substituteTemplate :: String -> String -> String
-substituteTemplate baseTemplate pkgId = T.unpack . T.replace "%pkg%" (T.pack pkgId) . T.pack $ baseTemplate
+substituteTemplate :: String -> (String, String) -> String
+substituteTemplate baseTemplate (pkg, pkgId) =
+ T.unpack
+ . T.replace "%pkg%" (T.pack pkg)
+ . T.replace "%pkgid%" (T.pack pkgId)
+ . T.pack $ baseTemplate
=====================================
libraries/filepath
=====================================
@@ -1 +1 @@
-Subproject commit b55465e3d174ccd63914e7146079435503204187
+Subproject commit 4dd36add328032f9cbf0eff2a3511ab4369b18eb
=====================================
libraries/ghc-experimental/src/Data/Sum/Experimental.hs
=====================================
@@ -80,4 +80,5 @@ module Data.Sum.Experimental (
Sum63#,
) where
+import GHC.Num.BigNat () -- for build ordering
import GHC.Types
=====================================
libraries/ghc-experimental/src/Data/Tuple/Experimental.hs
=====================================
@@ -161,3 +161,4 @@ module Data.Tuple.Experimental (
import GHC.Tuple
import GHC.Types
import GHC.Classes
+import GHC.Num.BigNat () -- for build ordering
=====================================
libraries/ghc-experimental/src/GHC/Profiling/Eras.hs
=====================================
@@ -1,7 +1,6 @@
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
--- | TODO move this module into ghc-internals
module GHC.Profiling.Eras ( setUserEra
, getUserEra
, incrementUserEra
=====================================
libraries/ghc-internal/ghc-internal.cabal
=====================================
@@ -17,7 +17,7 @@ description:
extra-tmp-files:
autom4te.cache
- base.buildinfo
+ ghc-internal.buildinfo
config.log
config.status
include/EventConfig.h
@@ -25,8 +25,8 @@ extra-tmp-files:
extra-source-files:
aclocal.m4
- base.buildinfo.in
- changelog.md
+ ghc-internal.buildinfo.in
+ CHANGELOG.md
configure
configure.ac
include/CTypes.h
=====================================
libraries/os-string
=====================================
@@ -1 +1 @@
-Subproject commit fb2711ba1f43fd609de0e231e161025ee8ed3216
+Subproject commit 6c567f572e62437b8431b0f64b91393c40b677c8
=====================================
testsuite/tests/perf/compiler/T24471.hs
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T24471 where
+
+import T24471a
+
+{-# OPAQUE foo #-}
+foo :: (List_ Int a -> a) -> a
+foo alg = $$(between [|| alg ||] 0 1000)
=====================================
testsuite/tests/perf/compiler/T24471a.hs
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T24471a where
+
+data List_ a f = Nil_ | Cons_ a f deriving Functor
+
+between alg a b
+ | a == b = [|| $$alg Nil_ ||]
+ | otherwise = [|| $$alg (Cons_ a $$(between alg (a + 1) b)) ||]
=====================================
testsuite/tests/perf/compiler/all.T
=====================================
@@ -712,3 +712,7 @@ test ('LookupFusion',
[collect_stats('bytes allocated',2), when(wordsize(32), skip)],
compile_and_run,
['-O2 -package base'])
+
+test('T24471',
+ [ collect_compiler_stats('all', 5) ],
+ multimod_compile, ['T24471', '-v0 -O'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/557ac3d9646c37baf627e784cf078bf9cb866f6f...5c227bca89edb27b4328b9ed8b28c393d4cc312a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/557ac3d9646c37baf627e784cf078bf9cb866f6f...5c227bca89edb27b4328b9ed8b28c393d4cc312a
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240305/e0be0365/attachment-0001.html>
More information about the ghc-commits
mailing list