[Git][ghc/ghc][wip/ubuntu-18_04] 12 commits: Allow waiting for timerfd to be interrupted during rts shutdown
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Thu Jan 26 08:42:05 UTC 2023
Matthew Pickering pushed to branch wip/ubuntu-18_04 at Glasgow Haskell Compiler / GHC
Commits:
e5383a29 by Wander Hillen at 2023-01-24T20:02:26-05:00
Allow waiting for timerfd to be interrupted during rts shutdown
- - - - -
1957eda1 by Ryan Scott at 2023-01-24T20:03:01-05:00
Restore Compose's Read/Show behavior to match Read1/Show1 instances
Fixes #22816.
- - - - -
30972827 by Matthew Pickering at 2023-01-25T03:54:14-05:00
docs: Update INSTALL.md
Removes references to make.
Fixes #22480
- - - - -
bc038c3b by Cheng Shao at 2023-01-25T03:54:50-05:00
compiler: fix handling of MO_F_Neg in wasm NCG
In the wasm NCG, we used to compile MO_F_Neg to 0.0-x. It was an
oversight, there actually exists f32.neg/f64.neg opcodes in the wasm
spec and those should be used instead! The old behavior almost works,
expect when GHC compiles the -0.0 literal, which will incorrectly
become 0.0.
- - - - -
e987e345 by Sylvain Henry at 2023-01-25T14:47:41-05:00
Hadrian: correctly detect AR at-file support
Stage0's ar may not support at-files. Take it into account.
Found while cross-compiling from Darwin to Windows.
- - - - -
48131ee2 by Sylvain Henry at 2023-01-25T14:47:41-05:00
Hadrian: fix Windows cross-compilation
Decision to build either unix or Win32 package must be stage specific
for cross-compilation to be supported.
- - - - -
288fa017 by Sylvain Henry at 2023-01-25T14:47:41-05:00
Fix RTS build on Windows
This change fixes a cross-compilation issue from ArchLinux to Windows
because these symbols weren't found.
- - - - -
2fdf22ae by Sylvain Henry at 2023-01-25T14:47:41-05:00
configure: support "windows" as an OS
- - - - -
13a0566b by Simon Peyton Jones at 2023-01-25T14:48:16-05:00
Fix in-scope set in specImports
Nothing deep here; I had failed to bring some
floated dictionary binders into scope.
Exposed by -fspecialise-aggressively
Fixes #22715.
- - - - -
b7efdb24 by Matthew Pickering at 2023-01-25T14:48:51-05:00
ci: Disable HLint job due to excessive runtime
The HLint jobs takes much longer to run (20 minutes) after "Give the RTS it's own configure script" eb5a6b91
Now the CI job will build the stage0 compiler before it generates the necessary RTS headers.
We either need to:
* Fix the linting rules so they take much less time
* Revert the commit
* Remove the linting of base from the hlint job
* Remove the hlint job
This is highest priority as it is affecting all CI pipelines.
For now I am just disabling the job because there are many more pressing
matters at hand.
Ticket #22830
- - - - -
0a022207 by Matthew Pickering at 2023-01-26T08:41:56+00:00
ci: Add ubuntu18_04 nightly and release jobs
This adds release jobs for ubuntu18_04 which uses glibc 2.27 which is
older than the 2.28 which is used by Rocky8 bindists.
Ticket #22268
- - - - -
2e3dbafa by Matthew Pickering at 2023-01-26T08:41:56+00:00
rel-eng: Add missing rocky8 bindist
We intend to release rocky8 bindist so the fetching script needs to know
about them.
- - - - -
25 changed files:
- .gitlab-ci.yml
- .gitlab/gen_ci.hs
- .gitlab/jobs.yaml
- .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py
- INSTALL.md
- compiler/GHC/CmmToAsm/Wasm/Asm.hs
- compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
- compiler/GHC/CmmToAsm/Wasm/Types.hs
- compiler/GHC/Core/Opt/Specialise.hs
- docs/users_guide/9.8.1-notes.rst
- hadrian/cfg/system.config.in
- hadrian/src/Builder.hs
- hadrian/src/Oracles/Flag.hs
- hadrian/src/Settings/Default.hs
- libraries/base/Data/Functor/Compose.hs
- + libraries/base/tests/T22816.hs
- + libraries/base/tests/T22816.stdout
- libraries/base/tests/all.T
- m4/fptools_set_haskell_platform_vars.m4
- m4/ghc_convert_os.m4
- rts/RtsSymbols.c
- rts/posix/ticker/Pthread.c
- + testsuite/tests/simplCore/should_compile/T22715_2.hs
- + testsuite/tests/simplCore/should_compile/T22715_2a.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -2,7 +2,7 @@ variables:
GIT_SSL_NO_VERIFY: "1"
# Commit of ghc/ci-images repository from which to pull Docker images
- DOCKER_REV: dd01591a50ea4e2aa3c106cf50ca54d38663f912
+ DOCKER_REV: 2d59d551647d102c4af44f257c520a94f04ea3f6
# Sequential version number of all cached things.
# Bump to invalidate GitLab CI cache.
@@ -329,7 +329,8 @@ lint-submods-branch:
paths:
- cabal-cache
-hlint-ghc-and-base:
+# Disabled due to #22830
+.hlint-ghc-and-base:
extends: .lint-params
image: "registry.gitlab.haskell.org/ghc/ci-images/linters:$DOCKER_REV"
variables:
=====================================
.gitlab/gen_ci.hs
=====================================
@@ -112,6 +112,7 @@ data LinuxDistro
= Debian11 | Debian10 | Debian9
| Fedora33
| Ubuntu2004
+ | Ubuntu1804
| Centos7
| Alpine
| Rocky8
@@ -270,6 +271,7 @@ distroName Debian11 = "deb11"
distroName Debian10 = "deb10"
distroName Debian9 = "deb9"
distroName Fedora33 = "fedora33"
+distroName Ubuntu1804 = "ubuntu18_04"
distroName Ubuntu2004 = "ubuntu20_04"
distroName Centos7 = "centos7"
distroName Alpine = "alpine3_12"
@@ -860,6 +862,7 @@ job_groups =
-- We still build Deb9 bindists for now due to Ubuntu 18 and Linux Mint 19
-- not being at EOL until April 2023 and they still need tinfo5.
, disableValidate (standardBuildsWithConfig Amd64 (Linux Debian9) (splitSectionsBroken vanilla))
+ , disableValidate (standardBuilds Amd64 (Linux Ubuntu1804))
, disableValidate (standardBuilds Amd64 (Linux Ubuntu2004))
, disableValidate (standardBuilds Amd64 (Linux Rocky8))
, disableValidate (standardBuildsWithConfig Amd64 (Linux Centos7) (splitSectionsBroken vanilla))
=====================================
.gitlab/jobs.yaml
=====================================
@@ -1872,6 +1872,65 @@
"XZ_OPT": "-9"
}
},
+ "nightly-x86_64-linux-ubuntu18_04-validate": {
+ "after_script": [
+ ".gitlab/ci.sh save_cache",
+ ".gitlab/ci.sh clean",
+ "cat ci_timings"
+ ],
+ "allow_failure": false,
+ "artifacts": {
+ "expire_in": "8 weeks",
+ "paths": [
+ "ghc-x86_64-linux-ubuntu18_04-validate.tar.xz",
+ "junit.xml"
+ ],
+ "reports": {
+ "junit": "junit.xml"
+ },
+ "when": "always"
+ },
+ "cache": {
+ "key": "x86_64-linux-ubuntu18_04-$CACHE_REV",
+ "paths": [
+ "cabal-cache",
+ "toolchain"
+ ]
+ },
+ "dependencies": [],
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-ubuntu18_04:$DOCKER_REV",
+ "needs": [
+ {
+ "artifacts": false,
+ "job": "hadrian-ghc-in-ghci"
+ }
+ ],
+ "rules": [
+ {
+ "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB != \"yes\") && ($NIGHTLY) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")",
+ "when": "on_success"
+ }
+ ],
+ "script": [
+ "sudo chown ghc:ghc -R .",
+ ".gitlab/ci.sh setup",
+ ".gitlab/ci.sh configure",
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian"
+ ],
+ "stage": "full-build",
+ "tags": [
+ "x86_64-linux"
+ ],
+ "variables": {
+ "BIGNUM_BACKEND": "gmp",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-validate",
+ "BUILD_FLAVOUR": "validate",
+ "CONFIGURE_ARGS": "",
+ "TEST_ENV": "x86_64-linux-ubuntu18_04-validate",
+ "XZ_OPT": "-9"
+ }
+ },
"nightly-x86_64-linux-ubuntu20_04-validate": {
"after_script": [
".gitlab/ci.sh save_cache",
@@ -3038,6 +3097,66 @@
"XZ_OPT": "-9"
}
},
+ "release-x86_64-linux-ubuntu18_04-release": {
+ "after_script": [
+ ".gitlab/ci.sh save_cache",
+ ".gitlab/ci.sh clean",
+ "cat ci_timings"
+ ],
+ "allow_failure": false,
+ "artifacts": {
+ "expire_in": "1 year",
+ "paths": [
+ "ghc-x86_64-linux-ubuntu18_04-release.tar.xz",
+ "junit.xml"
+ ],
+ "reports": {
+ "junit": "junit.xml"
+ },
+ "when": "always"
+ },
+ "cache": {
+ "key": "x86_64-linux-ubuntu18_04-$CACHE_REV",
+ "paths": [
+ "cabal-cache",
+ "toolchain"
+ ]
+ },
+ "dependencies": [],
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-ubuntu18_04:$DOCKER_REV",
+ "needs": [
+ {
+ "artifacts": false,
+ "job": "hadrian-ghc-in-ghci"
+ }
+ ],
+ "rules": [
+ {
+ "if": "($CI_MERGE_REQUEST_LABELS !~ /.*fast-ci.*/) && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null) && (\"true\" == \"true\") && (\"true\" == \"true\") && (\"true\" == \"true\")",
+ "when": "on_success"
+ }
+ ],
+ "script": [
+ "sudo chown ghc:ghc -R .",
+ ".gitlab/ci.sh setup",
+ ".gitlab/ci.sh configure",
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian"
+ ],
+ "stage": "full-build",
+ "tags": [
+ "x86_64-linux"
+ ],
+ "variables": {
+ "BIGNUM_BACKEND": "gmp",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu18_04-release",
+ "BUILD_FLAVOUR": "release",
+ "CONFIGURE_ARGS": "",
+ "IGNORE_PERF_FAILURES": "all",
+ "TEST_ENV": "x86_64-linux-ubuntu18_04-release",
+ "XZ_OPT": "-9"
+ }
+ },
"release-x86_64-linux-ubuntu20_04-release": {
"after_script": [
".gitlab/ci.sh save_cache",
=====================================
.gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py
=====================================
@@ -16,7 +16,9 @@ def job_triple(job_name):
bindists = {
'release-x86_64-windows-release': 'x86_64-unknown-mingw32',
'release-x86_64-windows-int_native-release': 'x86_64-unknown-mingw32-int_native',
+ 'release-x86_64-rocky8-release': 'x86_64-rocky8-linux',
'release-x86_64-ubuntu20_04-release': 'x86_64-ubuntu20_04-linux',
+ 'release-x86_64-ubuntu18_04-release': 'x86_64-ubuntu18_04-linux',
'release-x86_64-linux-fedora33-release+debug_info': 'x86_64-fedora33-linux-dwarf',
'release-x86_64-linux-fedora33-release': 'x86_64-fedora33-linux',
'release-x86_64-linux-fedora27-release': 'x86_64-fedora27-linux',
=====================================
INSTALL.md
=====================================
@@ -20,15 +20,14 @@ Quick start: the following gives you a default build:
$ ./boot
$ ./configure
- $ make
- $ make install
+ $ ./hadrian/build
On Windows, you need an extra repository containing some build tools.
These can be downloaded for you by configure. This only needs to be done once by running:
$ ./configure --enable-tarballs-autodownload
-You can use Make's `-jN` option to parallelize the build. It's generally best
+You can use `-jN` option to parallelize the build. It's generally best
to set `N` somewhere around the core count of the build machine.
The `./boot` step is only necessary if this is a tree checked out from
=====================================
compiler/GHC/CmmToAsm/Wasm/Asm.hs
=====================================
@@ -359,6 +359,7 @@ asmTellWasmInstr ty_word instr = case instr of
WasmF32DemoteF64 -> asmTellLine "f32.demote_f64"
WasmF64PromoteF32 -> asmTellLine "f64.promote_f32"
WasmAbs ty -> asmTellLine $ asmFromWasmType ty <> ".abs"
+ WasmNeg ty -> asmTellLine $ asmFromWasmType ty <> ".neg"
WasmCond t -> do
asmTellLine "if"
asmWithTab $ asmTellWasmInstr ty_word t
=====================================
compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
=====================================
@@ -224,6 +224,28 @@ extendSubword W32 TagI64 (WasmExpr instr) =
WasmExpr $ instr `WasmConcat` WasmI64Extend32S
extendSubword _ _ expr = expr
+-- | Lower an unary homogeneous operation.
+lower_MO_Un_Homo ::
+ ( forall pre t.
+ WasmTypeTag t ->
+ WasmInstr
+ w
+ (t : pre)
+ (t : pre)
+ ) ->
+ CLabel ->
+ CmmType ->
+ [CmmExpr] ->
+ WasmCodeGenM w (SomeWasmExpr w)
+lower_MO_Un_Homo op lbl t0 [x] = case someWasmTypeFromCmmType t0 of
+ SomeWasmType ty -> do
+ WasmExpr x_instr <- lower_CmmExpr_Typed lbl ty x
+ pure $
+ SomeWasmExpr ty $
+ WasmExpr $
+ x_instr `WasmConcat` op ty
+lower_MO_Un_Homo _ _ _ _ = panic "lower_MO_Un_Homo: unreachable"
+
-- | Lower a binary homogeneous operation. Homogeneous: result type is
-- the same with operand types.
lower_MO_Bin_Homo ::
@@ -699,11 +721,12 @@ lower_CmmMachOp lbl (MO_F_Sub w0) xs =
lbl
(cmmFloat w0)
xs
-lower_CmmMachOp lbl (MO_F_Neg w0) [x] =
- lower_CmmMachOp
+lower_CmmMachOp lbl (MO_F_Neg w0) xs =
+ lower_MO_Un_Homo
+ WasmNeg
lbl
- (MO_F_Sub w0)
- [CmmLit $ CmmFloat 0 w0, x]
+ (cmmFloat w0)
+ xs
lower_CmmMachOp lbl (MO_F_Mul w0) xs =
lower_MO_Bin_Homo
WasmMul
=====================================
compiler/GHC/CmmToAsm/Wasm/Types.hs
=====================================
@@ -305,6 +305,7 @@ data WasmInstr :: WasmType -> [WasmType] -> [WasmType] -> Type where
WasmF32DemoteF64 :: WasmInstr w ('F64 : pre) ('F32 : pre)
WasmF64PromoteF32 :: WasmInstr w ('F32 : pre) ('F64 : pre)
WasmAbs :: WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
+ WasmNeg :: WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)
WasmCond :: WasmInstr w pre pre -> WasmInstr w (w : pre) pre
newtype WasmExpr w t = WasmExpr (forall pre. WasmInstr w pre (t : pre))
=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -33,6 +33,7 @@ import GHC.Core.Utils ( exprIsTrivial
import GHC.Core.FVs
import GHC.Core.TyCo.FVs ( tyCoVarsOfTypeList )
import GHC.Core.Opt.Arity( collectBindersPushingCo )
+-- import GHC.Core.Ppr( pprIds )
import GHC.Builtin.Types ( unboxedUnitTy )
@@ -736,7 +737,8 @@ specImports top_env (MkUD { ud_binds = dict_binds, ud_calls = calls })
= return ([], wrapDictBinds dict_binds [])
| otherwise
- = do { (_env, spec_rules, spec_binds) <- spec_imports top_env [] dict_binds calls
+ = do { let env_w_dict_bndrs = top_env `bringFloatedDictsIntoScope` dict_binds
+ ; (_env, spec_rules, spec_binds) <- spec_imports env_w_dict_bndrs [] dict_binds calls
-- Don't forget to wrap the specialized bindings with
-- bindings for the needed dictionaries.
@@ -752,6 +754,7 @@ specImports top_env (MkUD { ud_binds = dict_binds, ud_calls = calls })
-- | Specialise a set of calls to imported bindings
spec_imports :: SpecEnv -- Passed in so that all top-level Ids are in scope
+ ---In-scope set includes the FloatedDictBinds
-> [Id] -- Stack of imported functions being specialised
-- See Note [specImport call stack]
-> FloatedDictBinds -- Dict bindings, used /only/ for filterCalls
@@ -781,6 +784,7 @@ spec_imports env callers dict_binds calls
; return (env, rules1 ++ rules2, spec_binds1 ++ spec_binds2) }
spec_import :: SpecEnv -- Passed in so that all top-level Ids are in scope
+ ---In-scope set includes the FloatedDictBinds
-> [Id] -- Stack of imported functions being specialised
-- See Note [specImport call stack]
-> FloatedDictBinds -- Dict bindings, used /only/ for filterCalls
@@ -806,23 +810,35 @@ spec_import env callers dict_binds cis@(CIS fn _)
; eps_rules <- getExternalRuleBase
; let rule_env = se_rules env `updExternalPackageRules` eps_rules
--- ; debugTraceMsg (text "specImport1" <+> vcat [ppr fn, ppr good_calls
--- , ppr (getRules rule_env fn), ppr rhs])
+-- ; debugTraceMsg (text "specImport1" <+> vcat
+-- [ text "function:" <+> ppr fn
+-- , text "good calls:" <+> ppr good_calls
+-- , text "existing rules:" <+> ppr (getRules rule_env fn)
+-- , text "rhs:" <+> ppr rhs
+-- , text "dict_binds:" <+> ppr dict_binds ])
+
; (rules1, spec_pairs, MkUD { ud_binds = dict_binds1, ud_calls = new_calls })
- <- runSpecM $ specCalls True env dict_binds
- (getRules rule_env fn) good_calls fn rhs
+ <- runSpecM $ specCalls True env (getRules rule_env fn) good_calls fn rhs
; let spec_binds1 = [NonRec b r | (b,r) <- spec_pairs]
- -- After the rules kick in we may get recursion, but
- -- we rely on a global GlomBinds to sort that out later
+ -- After the rules kick in, via fireRewriteRules, we may get recursion,
+ -- but we rely on a global GlomBinds to sort that out later
-- See Note [Glom the bindings if imported functions are specialised]
+ -- Meanwhile, though, bring the binders into scope
new_subst = se_subst env `Core.extendSubstInScopeList` map fst spec_pairs
new_env = env { se_rules = rule_env `addLocalRules` rules1
, se_subst = new_subst }
+ `bringFloatedDictsIntoScope` dict_binds1
+
+ -- Now specialise any cascaded calls
+-- ; debugTraceMsg (text "specImport 2" <+> vcat
+-- [ text "function:" <+> ppr fn
+-- , text "rules1:" <+> ppr rules1
+-- , text "spec_binds1" <+> ppr spec_binds1
+-- , text "dict_binds1" <+> ppr dict_binds1
+-- , text "new_calls" <+> ppr new_calls ])
- -- Now specialise any cascaded calls
--- ; debugTraceMsg (text "specImport 2" <+> (ppr fn $$ ppr rules1 $$ ppr spec_binds1))
; (env, rules2, spec_binds2)
<- spec_imports new_env (fn:callers)
(dict_binds `thenFDBs` dict_binds1)
@@ -1561,10 +1577,11 @@ specDefn :: SpecEnv
specDefn env body_uds fn rhs
= do { let (body_uds_without_me, calls_for_me) = callsForMe fn body_uds
rules_for_me = idCoreRules fn
- dict_binds = ud_binds body_uds
+ -- Bring into scope the binders from the floated dicts
+ env_w_dict_bndrs = bringFloatedDictsIntoScope env (ud_binds body_uds)
- ; (rules, spec_defns, spec_uds) <- specCalls False env dict_binds
- rules_for_me calls_for_me fn rhs
+ ; (rules, spec_defns, spec_uds) <- specCalls False env_w_dict_bndrs
+ rules_for_me calls_for_me fn rhs
; return ( fn `addIdSpecialisations` rules
, spec_defns
@@ -1580,7 +1597,6 @@ specDefn env body_uds fn rhs
specCalls :: Bool -- True => specialising imported fn
-- False => specialising local fn
-> SpecEnv
- -> FloatedDictBinds -- Just so that we can extend the in-scope set
-> [CoreRule] -- Existing RULES for the fn
-> [CallInfo]
-> OutId -> InExpr
@@ -1594,7 +1610,7 @@ type SpecInfo = ( [CoreRule] -- Specialisation rules
, [(Id,CoreExpr)] -- Specialised definition
, UsageDetails ) -- Usage details from specialised RHSs
-specCalls spec_imp env dict_binds existing_rules calls_for_me fn rhs
+specCalls spec_imp env existing_rules calls_for_me fn rhs
-- The first case is the interesting one
| notNull calls_for_me -- And there are some calls to specialise
&& not (isNeverActive (idInlineActivation fn))
@@ -1610,8 +1626,11 @@ specCalls spec_imp env dict_binds existing_rules calls_for_me fn rhs
-- See Note [Inline specialisations] for why we do not
-- switch off specialisation for inline functions
- = -- pprTrace "specCalls: some" (ppr fn $$ ppr calls_for_me $$ ppr existing_rules) $
- foldlM spec_call ([], [], emptyUDs) calls_for_me
+ = do { -- debugTraceMsg (text "specCalls: some" <+> vcat
+ -- [ text "function" <+> ppr fn
+ -- , text "calls:" <+> ppr calls_for_me
+ -- , text "subst" <+> ppr (se_subst env) ])
+ ; foldlM spec_call ([], [], emptyUDs) calls_for_me }
| otherwise -- No calls or RHS doesn't fit our preconceptions
= warnPprTrace (not (exprIsTrivial rhs) && notNull calls_for_me && not (isClassOpId fn))
@@ -1639,9 +1658,6 @@ specCalls spec_imp env dict_binds existing_rules calls_for_me fn rhs
(rhs_bndrs, rhs_body) = collectBindersPushingCo rhs
-- See Note [Account for casts in binding]
- -- Bring into scope the binders from the floated dicts
- env_with_dict_bndrs = bringFloatedDictsIntoScope env dict_binds
-
already_covered :: SpecEnv -> [CoreRule] -> [CoreExpr] -> Bool
already_covered env new_rules args -- Note [Specialisations already covered]
= isJust (specLookupRule env fn args (beginPhase inl_act)
@@ -1667,22 +1683,22 @@ specCalls spec_imp env dict_binds existing_rules calls_for_me fn rhs
; ( useful, rhs_env2, leftover_bndrs
, rule_bndrs, rule_lhs_args
- , spec_bndrs1, dx_binds, spec_args) <- specHeader env_with_dict_bndrs
- rhs_bndrs all_call_args
-
--- ; pprTrace "spec_call" (vcat [ text "fun: " <+> ppr fn
--- , text "call info: " <+> ppr _ci
--- , text "useful: " <+> ppr useful
--- , text "rule_bndrs:" <+> ppr rule_bndrs
--- , text "lhs_args: " <+> ppr rule_lhs_args
--- , text "spec_bndrs1:" <+> ppr spec_bndrs1
--- , text "leftover_bndrs:" <+> pprIds leftover_bndrs
--- , text "spec_args: " <+> ppr spec_args
--- , text "dx_binds: " <+> ppr dx_binds
--- , text "rhs_body" <+> ppr rhs_body
--- , text "rhs_env2: " <+> ppr (se_subst rhs_env2)
--- , ppr dx_binds ]) $
--- return ()
+ , spec_bndrs1, dx_binds, spec_args) <- specHeader env rhs_bndrs all_call_args
+
+-- ; debugTraceMsg (text "spec_call" <+> vcat
+-- [ text "fun: " <+> ppr fn
+-- , text "call info: " <+> ppr _ci
+-- , text "useful: " <+> ppr useful
+-- , text "rule_bndrs:" <+> ppr rule_bndrs
+-- , text "lhs_args: " <+> ppr rule_lhs_args
+-- , text "spec_bndrs1:" <+> ppr spec_bndrs1
+-- , text "leftover_bndrs:" <+> pprIds leftover_bndrs
+-- , text "spec_args: " <+> ppr spec_args
+-- , text "dx_binds: " <+> ppr dx_binds
+-- , text "rhs_bndrs" <+> ppr rhs_bndrs
+-- , text "rhs_body" <+> ppr rhs_body
+-- , text "rhs_env2: " <+> ppr (se_subst rhs_env2)
+-- , ppr dx_binds ]
; if not useful -- No useful specialisation
|| already_covered rhs_env2 rules_acc rule_lhs_args
=====================================
docs/users_guide/9.8.1-notes.rst
=====================================
@@ -10,4 +10,74 @@ Compiler
~~~~~~~~
- Added a new warning :ghc-flag:`-Wterm-variable-capture` that helps to make code compatible with
- the future extension ``RequiredTypeArguments``.
\ No newline at end of file
+ the future extension ``RequiredTypeArguments``.
+=======
+
+GHCi
+~~~~
+
+
+Runtime system
+~~~~~~~~~~~~~~
+
+- On POSIX systems that support timerfd, RTS shutdown no longer has to wait for
+ the next RTS 'tick' to occur before continuing the shutdown process. See #22692.
+
+``base`` library
+~~~~~~~~~~~~~~~~
+
+
+``ghc-prim`` library
+~~~~~~~~~~~~~~~~~~~~
+
+``ghc`` library
+~~~~~~~~~~~~~~~
+
+``ghc-heap`` library
+~~~~~~~~~~~~~~~~~~~~
+
+
+Included libraries
+------------------
+
+The package database provided with this distribution also contains a number of
+packages other than GHC itself. See the changelogs provided with these packages
+for further change information.
+
+.. ghc-package-list::
+
+ libraries/array/array.cabal: Dependency of ``ghc`` library
+ libraries/base/base.cabal: Core library
+ libraries/binary/binary.cabal: Dependency of ``ghc`` library
+ libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library
+ libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility
+ libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal: Dependency of ``ghc-pkg`` utility
+ libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library
+ libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library
+ libraries/directory/directory.cabal: Dependency of ``ghc`` library
+ libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library
+ libraries/filepath/filepath.cabal: Dependency of ``ghc`` library
+ compiler/ghc.cabal: The compiler itself
+ libraries/ghci/ghci.cabal: The REPL interface
+ libraries/ghc-boot/ghc-boot.cabal: Internal compiler library
+ libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library
+ libraries/ghc-compact/ghc-compact.cabal: Core library
+ libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library
+ libraries/ghc-prim/ghc-prim.cabal: Core library
+ libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable
+ libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable
+ libraries/integer-gmp/integer-gmp.cabal: Core library
+ libraries/libiserv/libiserv.cabal: Internal compiler library
+ libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library
+ libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library
+ libraries/pretty/pretty.cabal: Dependency of ``ghc`` library
+ libraries/process/process.cabal: Dependency of ``ghc`` library
+ libraries/stm/stm.cabal: Dependency of ``haskeline`` library
+ libraries/template-haskell/template-haskell.cabal: Core library
+ libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library
+ libraries/text/text.cabal: Dependency of ``Cabal`` library
+ libraries/time/time.cabal: Dependency of ``ghc`` library
+ libraries/transformers/transformers.cabal: Dependency of ``ghc`` library
+ libraries/unix/unix.cabal: Dependency of ``ghc`` library
+ libraries/Win32/Win32.cabal: Dependency of ``ghc`` library
+ libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable
=====================================
hadrian/cfg/system.config.in
=====================================
@@ -40,6 +40,7 @@ python = @PythonCmd@
#============================
ar-supports-at-file = @ArSupportsAtFile@
+system-ar-supports-at-file = @ArSupportsAtFile_STAGE0@
ar-supports-dash-l = @ArSupportsDashL@
system-ar-supports-dash-l = @ArSupportsDashL_STAGE0@
cc-llvm-backend = @CcLlvmBackend@
=====================================
hadrian/src/Builder.hs
=====================================
@@ -312,8 +312,8 @@ instance H.Builder Builder where
-- see Note [Capture stdout as a ByteString]
writeFileChangedBS output stdout
case builder of
- Ar Pack _ -> do
- useTempFile <- flag ArSupportsAtFile
+ Ar Pack stg -> do
+ useTempFile <- arSupportsAtFile stg
if useTempFile then runAr path buildArgs buildInputs
else runArWithoutTempFile path buildArgs buildInputs
=====================================
hadrian/src/Oracles/Flag.hs
=====================================
@@ -7,7 +7,8 @@ module Oracles.Flag (
targetSupportsThreadedRts,
targetSupportsSMP,
useLibffiForAdjustors,
- arSupportsDashL
+ arSupportsDashL,
+ arSupportsAtFile
) where
import Hadrian.Oracles.TextFile
@@ -18,6 +19,7 @@ import Oracles.Setting
data Flag = ArSupportsAtFile
| ArSupportsDashL
+ | SystemArSupportsAtFile
| SystemArSupportsDashL
| CrossCompiling
| CcLlvmBackend
@@ -48,6 +50,7 @@ flag f = do
let key = case f of
ArSupportsAtFile -> "ar-supports-at-file"
ArSupportsDashL -> "ar-supports-dash-l"
+ SystemArSupportsAtFile-> "system-ar-supports-at-file"
SystemArSupportsDashL-> "system-ar-supports-dash-l"
CrossCompiling -> "cross-compiling"
CcLlvmBackend -> "cc-llvm-backend"
@@ -89,6 +92,10 @@ arSupportsDashL :: Stage -> Action Bool
arSupportsDashL (Stage0 {}) = flag SystemArSupportsDashL
arSupportsDashL _ = flag ArSupportsDashL
+arSupportsAtFile :: Stage -> Action Bool
+arSupportsAtFile (Stage0 {}) = flag SystemArSupportsAtFile
+arSupportsAtFile _ = flag ArSupportsAtFile
+
platformSupportsSharedLibs :: Action Bool
platformSupportsSharedLibs = do
windows <- isWinTarget
=====================================
hadrian/src/Settings/Default.hs
=====================================
@@ -72,7 +72,6 @@ stageBootPackages = return [lintersCommon, lintCommitMsg, lintSubmoduleRefs, lin
stage0Packages :: Action [Package]
stage0Packages = do
cross <- flag CrossCompiling
- winTarget <- isWinTarget
return $ [ binary
, bytestring
, cabalSyntax
@@ -102,7 +101,7 @@ stage0Packages = do
, transformers
, unlit
, hp2ps
- , if winTarget then win32 else unix
+ , if windowsHost then win32 else unix
]
++ [ terminfo | not windowsHost, not cross ]
++ [ timeout | windowsHost ]
@@ -111,7 +110,15 @@ stage0Packages = do
-- | Packages built in 'Stage1' by default. You can change this in "UserSettings".
stage1Packages :: Action [Package]
stage1Packages = do
- libraries0 <- filter isLibrary <$> stage0Packages
+ let good_stage0_package p
+ -- we only keep libraries for some reason
+ | not (isLibrary p) = False
+ -- but not win32/unix because it depends on cross-compilation target
+ | p == win32 = False
+ | p == unix = False
+ | otherwise = True
+
+ libraries0 <- filter good_stage0_package <$> stage0Packages
cross <- flag CrossCompiling
winTarget <- isWinTarget
@@ -138,6 +145,7 @@ stage1Packages = do
, stm
, unlit
, xhtml
+ , if winTarget then win32 else unix
]
, when (not cross)
[ haddock
=====================================
libraries/base/Data/Functor/Compose.hs
=====================================
@@ -33,7 +33,7 @@ import Data.Coerce (coerce)
import Data.Data (Data)
import Data.Type.Equality (TestEquality(..), (:~:)(..))
import GHC.Generics (Generic, Generic1)
-import Text.Read ()
+import Text.Read (Read(..), ReadPrec, readListDefault, readListPrecDefault)
infixr 9 `Compose`
@@ -55,9 +55,14 @@ deriving instance Eq (f (g a)) => Eq (Compose f g a)
-- | @since 4.18.0.0
deriving instance Ord (f (g a)) => Ord (Compose f g a)
-- | @since 4.18.0.0
-deriving instance Read (f (g a)) => Read (Compose f g a)
+instance Read (f (g a)) => Read (Compose f g a) where
+ readPrec = liftReadPrecCompose readPrec
+
+ readListPrec = readListPrecDefault
+ readList = readListDefault
-- | @since 4.18.0.0
-deriving instance Show (f (g a)) => Show (Compose f g a)
+instance Show (f (g a)) => Show (Compose f g a) where
+ showsPrec = liftShowsPrecCompose showsPrec
-- Instances of lifted Prelude classes
@@ -72,8 +77,8 @@ instance (Ord1 f, Ord1 g) => Ord1 (Compose f g) where
-- | @since 4.9.0.0
instance (Read1 f, Read1 g) => Read1 (Compose f g) where
- liftReadPrec rp rl = readData $
- readUnaryWith (liftReadPrec rp' rl') "Compose" Compose
+ liftReadPrec rp rl =
+ liftReadPrecCompose (liftReadPrec rp' rl')
where
rp' = liftReadPrec rp rl
rl' = liftReadListPrec rp rl
@@ -83,12 +88,20 @@ instance (Read1 f, Read1 g) => Read1 (Compose f g) where
-- | @since 4.9.0.0
instance (Show1 f, Show1 g) => Show1 (Compose f g) where
- liftShowsPrec sp sl d (Compose x) =
- showsUnaryWith (liftShowsPrec sp' sl') "Compose" d x
+ liftShowsPrec sp sl =
+ liftShowsPrecCompose (liftShowsPrec sp' sl')
where
sp' = liftShowsPrec sp sl
sl' = liftShowList sp sl
+-- The workhorse for Compose's Read and Read1 instances.
+liftReadPrecCompose :: ReadPrec (f (g a)) -> ReadPrec (Compose f g a)
+liftReadPrecCompose rp = readData $ readUnaryWith rp "Compose" Compose
+
+-- The workhorse for Compose's Show and Show1 instances.
+liftShowsPrecCompose :: (Int -> f (g a) -> ShowS) -> Int -> Compose f g a -> ShowS
+liftShowsPrecCompose sp d (Compose x) = showsUnaryWith sp "Compose" d x
+
-- Functor instances
-- | @since 4.9.0.0
=====================================
libraries/base/tests/T22816.hs
=====================================
@@ -0,0 +1,31 @@
+module Main (main) where
+
+import Data.Functor.Classes
+import Data.Functor.Compose
+import Text.ParserCombinators.ReadP as P
+import Text.ParserCombinators.ReadPrec (ReadPrec, lift, minPrec, readPrec_to_S)
+
+readEither' :: ReadPrec a -> String -> Either String a
+readEither' rp s =
+ case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
+ [x] -> Right x
+ [] -> Left "read1: no parse"
+ _ -> Left "read1: ambiguous parse"
+ where
+ read' =
+ do x <- rp
+ lift P.skipSpaces
+ return x
+
+-- | Like 'read', but tailored to 'Read1'.
+read1 :: (Read1 f, Read a) => String -> f a
+read1 s = either errorWithoutStackTrace id (readEither' readPrec1 s)
+
+exRead, exRead1 :: Compose Maybe Maybe Int
+exRead = read "Compose Nothing"
+exRead1 = read1 "Compose Nothing"
+
+main :: IO ()
+main = do
+ putStrLn $ showsPrec 0 exRead ""
+ putStrLn $ showsPrec1 0 exRead1 ""
=====================================
libraries/base/tests/T22816.stdout
=====================================
@@ -0,0 +1,2 @@
+Compose Nothing
+Compose Nothing
=====================================
libraries/base/tests/all.T
=====================================
@@ -286,6 +286,7 @@ test('T18642',
test('T19288', exit_code(1), compile_and_run, [''])
test('T19719', normal, compile_and_run, [''])
test('T20107', extra_run_opts('+RTS -M50M'), compile_and_run, ['-package bytestring'])
+test('T22816', normal, compile_and_run, [''])
test('trace', normal, compile_and_run, [''])
test('listThreads', js_broken(22261), compile_and_run, [''])
test('inits1tails1', normal, compile_and_run, [''])
=====================================
m4/fptools_set_haskell_platform_vars.m4
=====================================
@@ -82,7 +82,7 @@ AC_DEFUN([FPTOOLS_SET_HASKELL_PLATFORM_VARS_SHELL_FUNCTIONS],
solaris2)
test -z "[$]2" || eval "[$]2=OSSolaris2"
;;
- mingw32)
+ mingw32|windows)
test -z "[$]2" || eval "[$]2=OSMinGW32"
;;
freebsd)
=====================================
m4/ghc_convert_os.m4
=====================================
@@ -22,8 +22,11 @@ AC_DEFUN([GHC_CONVERT_OS],[
openbsd*)
$3="openbsd"
;;
+ windows|mingw32)
+ $3="mingw32"
+ ;;
# As far as I'm aware, none of these have relevant variants
- freebsd|dragonfly|hpux|linuxaout|kfreebsdgnu|freebsd2|mingw32|darwin|nextstep2|nextstep3|sunos4|ultrix|haiku)
+ freebsd|dragonfly|hpux|linuxaout|kfreebsdgnu|freebsd2|darwin|nextstep2|nextstep3|sunos4|ultrix|haiku)
$3="$1"
;;
msys)
=====================================
rts/RtsSymbols.c
=====================================
@@ -170,8 +170,6 @@ extern char **environ;
SymI_NeedsProto(__mingw_module_is_dll) \
RTS_WIN32_ONLY(SymI_NeedsProto(___chkstk_ms)) \
RTS_WIN64_ONLY(SymI_NeedsProto(___chkstk_ms)) \
- RTS_WIN64_ONLY(SymI_HasProto(__stdio_common_vswprintf_s)) \
- RTS_WIN64_ONLY(SymI_HasProto(__stdio_common_vswprintf)) \
RTS_WIN64_ONLY(SymI_HasProto(_errno)) \
/* see Note [Symbols for MinGW's printf] */ \
SymI_HasProto(_lock_file) \
=====================================
rts/posix/ticker/Pthread.c
=====================================
@@ -43,6 +43,7 @@
#include "Proftimer.h"
#include "Schedule.h"
#include "posix/Clock.h"
+#include <sys/poll.h>
#include <time.h>
#if HAVE_SYS_TIME_H
@@ -95,28 +96,53 @@ static OSThreadId thread;
// file descriptor for the timer (Linux only)
static int timerfd = -1;
+// pipe for signaling exit
+static int pipefds[2];
+
static void *itimer_thread_func(void *_handle_tick)
{
TickProc handle_tick = _handle_tick;
uint64_t nticks;
+ ssize_t r = 0;
+ struct pollfd pollfds[2];
+
+#if USE_TIMERFD_FOR_ITIMER
+ pollfds[0].fd = pipefds[0];
+ pollfds[0].events = POLLIN;
+ pollfds[1].fd = timerfd;
+ pollfds[1].events = POLLIN;
+#endif
// Relaxed is sufficient: If we don't see that exited was set in one iteration we will
// see it next time.
TSAN_ANNOTATE_BENIGN_RACE(&exited, "itimer_thread_func");
while (!RELAXED_LOAD(&exited)) {
if (USE_TIMERFD_FOR_ITIMER) {
- ssize_t r = read(timerfd, &nticks, sizeof(nticks));
- if ((r == 0) && (errno == 0)) {
- /* r == 0 is expected only for non-blocking fd (in which case
- * errno should be EAGAIN) but we use a blocking fd.
- *
- * Due to a kernel bug (cf https://lkml.org/lkml/2019/8/16/335)
- * on some platforms we could see r == 0 and errno == 0.
- */
- IF_DEBUG(scheduler, debugBelch("read(timerfd) returned 0 with errno=0. This is a known kernel bug. We just ignore it."));
+ if (poll(pollfds, 2, -1) == -1) {
+ sysErrorBelch("Ticker: poll failed: %s", strerror(errno));
}
- else if (r != sizeof(nticks) && errno != EINTR) {
- barf("Ticker: read(timerfd) failed with %s and returned %zd", strerror(errno), r);
+
+ // We check the pipe first, even though the timerfd may also have triggered.
+ if (pollfds[0].revents & POLLIN) {
+ // the pipe is ready for reading, the only possible reason is that we're exiting
+ exited = true; // set this again to make sure even RELAXED_LOAD will read the proper value
+ // no further action needed, skip ahead to handling the final tick and then stopping
+ }
+ else if (pollfds[1].revents & POLLIN) { // the timerfd is ready for reading
+ r = read(timerfd, &nticks, sizeof(nticks)); // this should never block now
+
+ if ((r == 0) && (errno == 0)) {
+ /* r == 0 is expected only for non-blocking fd (in which case
+ * errno should be EAGAIN) but we use a blocking fd.
+ *
+ * Due to a kernel bug (cf https://lkml.org/lkml/2019/8/16/335)
+ * on some platforms we could see r == 0 and errno == 0.
+ */
+ IF_DEBUG(scheduler, debugBelch("read(timerfd) returned 0 with errno=0. This is a known kernel bug. We just ignore it."));
+ }
+ else if (r != sizeof(nticks) && errno != EINTR) {
+ barf("Ticker: read(timerfd) failed with %s and returned %zd", strerror(errno), r);
+ }
}
} else {
if (rtsSleep(itimer_interval) != 0) {
@@ -138,8 +164,10 @@ static void *itimer_thread_func(void *_handle_tick)
}
}
- if (USE_TIMERFD_FOR_ITIMER)
+ if (USE_TIMERFD_FOR_ITIMER) {
close(timerfd);
+ }
+
return NULL;
}
@@ -185,6 +213,10 @@ initTicker (Time interval, TickProc handle_tick)
if (timerfd_settime(timerfd, 0, &it, NULL)) {
barf("timerfd_settime: %s", strerror(errno));
}
+
+ if (pipe(pipefds) < 0) {
+ barf("pipe: %s", strerror(errno));
+ }
#endif
/*
@@ -237,9 +269,21 @@ exitTicker (bool wait)
// wait for ticker to terminate if necessary
if (wait) {
+#if USE_TIMERFD_FOR_ITIMER
+ // write anything to the pipe to trigger poll() in the ticker thread
+ if (write(pipefds[1], "stop", 5) < 0) {
+ sysErrorBelch("Ticker: Failed to write to pipe: %s", strerror(errno));
+ }
+#endif
if (pthread_join(thread, NULL)) {
sysErrorBelch("Ticker: Failed to join: %s", strerror(errno));
}
+#if USE_TIMERFD_FOR_ITIMER
+ // These need to happen AFTER the ticker thread has finished to prevent a race condition
+ // where the ticker thread closes the read end of the pipe before we're done writing to it.
+ close(pipefds[0]);
+ close(pipefds[1]);
+#endif
closeMutex(&mutex);
closeCondition(&start_cond);
} else {
=====================================
testsuite/tests/simplCore/should_compile/T22715_2.hs
=====================================
@@ -0,0 +1,6 @@
+module T22715_2 where
+
+import T22715_2a
+
+debugTerminalKeys :: (forall m. CommandMonad m => m Char) -> Input IO Char
+debugTerminalKeys eval = runIdT eval
=====================================
testsuite/tests/simplCore/should_compile/T22715_2a.hs
=====================================
@@ -0,0 +1,29 @@
+{-# OPTIONS_GHC -Wno-missing-methods #-}
+
+module T22715_2a where
+
+newtype IdentityT m a = IdentityT (m a) deriving Functor
+newtype IdT m a = IdT {runIdT :: m a} deriving Functor
+
+class Functor m => SillyA m where
+ unused :: m a -> m a
+
+class SillyA m => SillyB m where
+ unused2 :: m a -> m a
+
+instance SillyA m => SillyA (IdentityT m) where
+instance SillyB m => SillyB (IdentityT m) where
+
+instance SillyA m => SillyA (IdT m) where
+instance SillyB m => SillyB (IdT m) where
+
+instance SillyA IO where
+instance SillyB IO where
+
+class Functor m => Special m
+instance Functor m => Special (IdT m)
+
+type Input m = IdentityT (IdentityT m)
+
+class (Special m, SillyB m) => CommandMonad m
+instance SillyB m => CommandMonad (IdT (Input m))
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -469,4 +469,4 @@ test('T22662', normal, compile, [''])
test('T22725', normal, compile, ['-O'])
test('T22502', normal, compile, ['-O'])
test('T22611', [when(wordsize(32), skip), grep_errmsg(r'\$salterF') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dsuppress-all'])
-
+test('T22715_2', normal, multimod_compile, ['T22715_2', '-v0 -O -fspecialise-aggressively'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1f80bb0d6904c274e88a56bc49e4967d20553974...2e3dbafa57013b250c92b031ce50962d4f5e13a3
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/1f80bb0d6904c274e88a56bc49e4967d20553974...2e3dbafa57013b250c92b031ce50962d4f5e13a3
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/20230126/16acf5f0/attachment-0001.html>
More information about the ghc-commits
mailing list