[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: base: Export GHC.Conc.Sync.fromThreadId
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed May 10 20:00:20 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
0de6eb02 by Ben Gamari at 2023-05-10T15:59:52-04:00
base: Export GHC.Conc.Sync.fromThreadId
Closes #22706.
- - - - -
c60d702d by Matthew Pickering at 2023-05-10T15:59:52-04:00
Build vanilla alpine bindists
We currently attempt to build and distribute fully static alpine
bindists (ones which could be used on any linux platform) but most
people who use the alpine bindists want to use alpine to build their own
static applications (for which a fully static bindist is not necessary).
We should build and distribute these bindists for these users whilst the
fully-static bindist is still unusable.
Fixes #23349
- - - - -
cb1d09e7 by Simon Peyton Jones at 2023-05-10T15:59:53-04:00
Look both ways when looking for quantified equalities
When looking up (t1 ~# t2) in the quantified constraints,
check both orientations. Forgetting this led to #23333.
- - - - -
d40d3736 by Rodrigo Mesquita at 2023-05-10T15:59:54-04:00
Move "target has RTS linker" out of settings
We move the "target has RTS linker" information out of configure into a
predicate in GHC, and remove this option from the settings file where it
is unnecessary -- it's information statically known from the platform.
Note that previously we would consider `powerpc`s and `s390x`s other
than `powerpc-ibm-aix*` and `s390x-ibm-linux` to have an RTS linker,
but the RTS linker supports neither platform.
Closes #23361
- - - - -
f6882ef1 by Krzysztof Gogolewski at 2023-05-10T15:59:55-04:00
Add a test for #17284
Since !10123 we now reject this program.
- - - - -
c2efebb7 by Bodigrim at 2023-05-10T15:59:58-04:00
Document unlawfulness of instance Num Fixed
Fixes #22712
- - - - -
27 changed files:
- .gitlab/gen_ci.hs
- .gitlab/jobs.yaml
- .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Platform.hs
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Solver/Interact.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Types.hs
- configure.ac
- distrib/configure.ac.in
- hadrian/bindist/Makefile
- hadrian/bindist/config.mk.in
- hadrian/cfg/system.config.in
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Settings/Builders/RunTest.hs
- libraries/base/Data/Fixed.hs
- libraries/base/GHC/Conc/Sync.hs
- libraries/base/GHC/Float.hs
- libraries/base/changelog.md
- + testsuite/tests/quantified-constraints/T23333.hs
- testsuite/tests/quantified-constraints/all.T
- + testsuite/tests/typecheck/should_fail/T17284.hs
- + testsuite/tests/typecheck/should_fail/T17284.stderr
- testsuite/tests/typecheck/should_fail/all.T
Changes:
=====================================
.gitlab/gen_ci.hs
=====================================
@@ -424,7 +424,7 @@ distroVariables Alpine = mconcat
-- T10458, ghcilink002: due to #17869
-- linker_unload_native: due to musl not supporting any means of probing dynlib dependencies
-- (see Note [Object unloading]).
- , "BROKEN_TESTS" =: "encoding004 T10458 ghcilink002 linker_unload_native"
+ , "BROKEN_TESTS" =: "encoding004 T10458 linker_unload_native"
]
distroVariables Centos7 = mconcat [
"HADRIAN_ARGS" =: "--docs=no-sphinx"
@@ -903,8 +903,11 @@ job_groups =
, standardBuildsWithConfig AArch64 (Linux Debian10) (splitSectionsBroken vanilla)
, disableValidate (validateBuilds AArch64 (Linux Debian10) llvm)
, standardBuildsWithConfig I386 (Linux Debian9) (splitSectionsBroken vanilla)
- , standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static)
- , disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt))
+ -- Fully static build, in theory usable on any linux distribution.
+ , fullyStaticBrokenTests (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken static))
+ -- Dynamically linked build, suitable for building your own static executables on alpine
+ , disableValidate (standardBuildsWithConfig Amd64 (Linux Alpine) (splitSectionsBroken vanilla))
+ , fullyStaticBrokenTests (disableValidate (allowFailureGroup (standardBuildsWithConfig Amd64 (Linux Alpine) staticNativeInt)))
, validateBuilds Amd64 (Linux Debian11) (crossConfig "aarch64-linux-gnu" (Emulator "qemu-aarch64 -L /usr/aarch64-linux-gnu") Nothing)
, validateBuilds Amd64 (Linux Debian11) (crossConfig "javascript-unknown-ghcjs" (Emulator "js-emulator") (Just "emconfigure")
)
@@ -919,6 +922,10 @@ job_groups =
]
where
+
+ -- ghcilink002 broken due to #17869
+ fullyStaticBrokenTests = modifyJobs (addVariable "BROKEN_TESTS" "ghcilink002 ")
+
hackage_doc_job = rename (<> "-hackage") . modifyJobs (addVariable "HADRIAN_ARGS" "--haddock-base-url")
tsan_jobs =
=====================================
.gitlab/jobs.yaml
=====================================
@@ -597,7 +597,7 @@
"variables": {
"BIGNUM_BACKEND": "native",
"BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-validate+fully_static",
- "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native",
+ "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native",
"BUILD_FLAVOUR": "validate+fully_static",
"CONFIGURE_ARGS": "--disable-ld-override ",
"HADRIAN_ARGS": "--docs=no-sphinx",
@@ -606,6 +606,68 @@
"XZ_OPT": "-9"
}
},
+ "nightly-x86_64-linux-alpine3_12-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-alpine3_12-validate.tar.xz",
+ "junit.xml"
+ ],
+ "reports": {
+ "junit": "junit.xml"
+ },
+ "when": "always"
+ },
+ "cache": {
+ "key": "x86_64-linux-alpine3_12-$CACHE_REV",
+ "paths": [
+ "cabal-cache",
+ "toolchain"
+ ]
+ },
+ "dependencies": [],
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$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\") && (\"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-alpine3_12-validate",
+ "BROKEN_TESTS": "encoding004 T10458 linker_unload_native",
+ "BUILD_FLAVOUR": "validate",
+ "CONFIGURE_ARGS": "--disable-ld-override ",
+ "HADRIAN_ARGS": "--docs=no-sphinx",
+ "INSTALL_CONFIGURE_ARGS": "--disable-ld-override",
+ "TEST_ENV": "x86_64-linux-alpine3_12-validate",
+ "XZ_OPT": "-9"
+ }
+ },
"nightly-x86_64-linux-alpine3_12-validate+fully_static": {
"after_script": [
".gitlab/ci.sh save_cache",
@@ -659,7 +721,7 @@
"variables": {
"BIGNUM_BACKEND": "gmp",
"BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static",
- "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native",
+ "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native",
"BUILD_FLAVOUR": "validate+fully_static",
"CONFIGURE_ARGS": "--disable-ld-override ",
"HADRIAN_ARGS": "--docs=no-sphinx",
@@ -2472,7 +2534,7 @@
"variables": {
"BIGNUM_BACKEND": "native",
"BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-int_native-release+fully_static",
- "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native",
+ "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native",
"BUILD_FLAVOUR": "release+fully_static",
"CONFIGURE_ARGS": "--disable-ld-override ",
"HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx",
@@ -2535,7 +2597,7 @@
"variables": {
"BIGNUM_BACKEND": "gmp",
"BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-release+fully_static+no_split_sections",
- "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native",
+ "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native",
"BUILD_FLAVOUR": "release+fully_static+no_split_sections",
"CONFIGURE_ARGS": "--disable-ld-override ",
"HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx",
@@ -2545,6 +2607,69 @@
"XZ_OPT": "-9"
}
},
+ "release-x86_64-linux-alpine3_12-release+no_split_sections": {
+ "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-alpine3_12-release+no_split_sections.tar.xz",
+ "junit.xml"
+ ],
+ "reports": {
+ "junit": "junit.xml"
+ },
+ "when": "always"
+ },
+ "cache": {
+ "key": "x86_64-linux-alpine3_12-$CACHE_REV",
+ "paths": [
+ "cabal-cache",
+ "toolchain"
+ ]
+ },
+ "dependencies": [],
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-alpine3_12:$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\") && (\"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-alpine3_12-release+no_split_sections",
+ "BROKEN_TESTS": "encoding004 T10458 linker_unload_native",
+ "BUILD_FLAVOUR": "release+no_split_sections",
+ "CONFIGURE_ARGS": "--disable-ld-override ",
+ "HADRIAN_ARGS": "--hash-unit-ids --docs=no-sphinx",
+ "IGNORE_PERF_FAILURES": "all",
+ "INSTALL_CONFIGURE_ARGS": "--disable-ld-override",
+ "TEST_ENV": "x86_64-linux-alpine3_12-release+no_split_sections",
+ "XZ_OPT": "-9"
+ }
+ },
"release-x86_64-linux-centos7-release+no_split_sections": {
"after_script": [
".gitlab/ci.sh save_cache",
@@ -3581,7 +3706,7 @@
"variables": {
"BIGNUM_BACKEND": "gmp",
"BIN_DIST_NAME": "ghc-x86_64-linux-alpine3_12-validate+fully_static",
- "BROKEN_TESTS": "encoding004 T10458 ghcilink002 linker_unload_native",
+ "BROKEN_TESTS": "ghcilink002 encoding004 T10458 linker_unload_native",
"BUILD_FLAVOUR": "validate+fully_static",
"CONFIGURE_ARGS": "--disable-ld-override ",
"HADRIAN_ARGS": "--docs=no-sphinx",
=====================================
.gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py
=====================================
@@ -30,6 +30,7 @@ def job_triple(job_name):
'release-x86_64-linux-deb9-release': 'x86_64-deb9-linux',
'release-x86_64-linux-centos7-release': 'x86_64-centos7-linux',
'release-x86_64-linux-alpine3_12-release+fully_static': 'x86_64-alpine3_12-linux-static',
+ 'release-x86_64-linux-alpine3_12-release': 'x86_64-alpine3_12-linux',
'release-x86_64-linux-alpine3_12-int_native-release+fully_static': 'x86_64-alpine3_12-linux-static-int_native',
'release-x86_64-darwin-release': 'x86_64-apple-darwin',
'release-i386-linux-deb9-release': 'i386-deb9-linux',
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -4830,8 +4830,9 @@ compilerInfo dflags
("Target platform", platformMisc_targetPlatformString $ platformMisc dflags),
("Have interpreter", showBool $ platformMisc_ghcWithInterpreter $ platformMisc dflags),
("Object splitting supported", showBool False),
- ("Have native code generator", showBool $ platformNcgSupported (targetPlatform dflags)),
- ("Target default backend", show $ platformDefaultBackend (targetPlatform dflags)),
+ ("Have native code generator", showBool $ platformNcgSupported platform),
+ ("target has RTS linker", showBool $ platformHasRTSLinker platform),
+ ("Target default backend", show $ platformDefaultBackend platform),
-- Whether or not we support @-dynamic-too@
("Support dynamic-too", showBool $ not isWindows),
-- Whether or not we support the @-j@ flag with @--make at .
=====================================
compiler/GHC/Platform.hs
=====================================
@@ -29,6 +29,7 @@ module GHC.Platform
, platformInIntRange
, platformInWordRange
, platformCConvNeedsExtension
+ , platformHasRTSLinker
, PlatformMisc(..)
, SseVersion (..)
, BmiVersion (..)
@@ -271,6 +272,23 @@ platformCConvNeedsExtension platform = case platformArch platform of
| OSDarwin <- platformOS platform -> True
_ -> False
+-- | Does this platform have an RTS linker?
+platformHasRTSLinker :: Platform -> Bool
+-- Note that we've inlined this logic in hadrian's
+-- Settings.Builders.RunTest.inTreeCompilerArgs.
+-- If you change this, be sure to change it too
+platformHasRTSLinker p = case archOS_arch (platformArchOS p) of
+ ArchPPC -> False -- powerpc
+ ArchPPC_64 ELF_V1 -> False -- powerpc64
+ ArchPPC_64 ELF_V2 -> False -- powerpc64le
+ ArchS390X -> False
+ ArchRISCV64 -> False
+ ArchLoongArch64 -> False
+ ArchJavaScript -> False
+ ArchWasm32 -> False
+ _ -> True
+
+
--------------------------------------------------
-- Instruction sets
=====================================
compiler/GHC/Tc/Solver/Dict.hs
=====================================
@@ -67,7 +67,7 @@ doTopReactDict inerts work_item@(CDictCan { cc_ev = ev, cc_class = cls
OneInst { cir_what = what }
-> do { insertSafeOverlapFailureTcS what work_item
; addSolvedDict what ev cls xis
- ; chooseInstance work_item lkup_res }
+ ; chooseInstance ev lkup_res }
_ -> -- NoInstance or NotSure
-- We didn't solve it; so try functional dependencies with
-- the instance environment
@@ -100,28 +100,24 @@ tryLastResortProhibitedSuperclass inerts
tryLastResortProhibitedSuperclass _ work_item
= continueWith work_item
-chooseInstance :: Ct -> ClsInstResult -> TcS (StopOrContinue Ct)
+chooseInstance :: CtEvidence -> ClsInstResult -> TcS (StopOrContinue Ct)
chooseInstance work_item
(OneInst { cir_new_theta = theta
, cir_what = what
, cir_mk_ev = mk_ev
, cir_coherence = coherence })
- = do { traceTcS "doTopReact/found instance for" $ ppr ev
+ = do { traceTcS "doTopReact/found instance for" $ ppr work_item
; deeper_loc <- checkInstanceOK loc what pred
; checkReductionDepth deeper_loc pred
- ; evb <- getTcEvBindsVar
- ; if isCoEvBindsVar evb
- then continueWith work_item
- -- See Note [Instances in no-evidence implications]
- else
- do { evc_vars <- mapM (newWanted deeper_loc (ctRewriters work_item)) theta
- ; setEvBindIfWanted ev coherence (mk_ev (map getEvExpr evc_vars))
- ; emitWorkNC (freshGoals evc_vars)
- ; stopWith ev "Dict/Top (solved wanted)" }}
+ ; assertPprM (getTcEvBindsVar >>= return . not . isCoEvBindsVar)
+ (ppr work_item)
+ ; evc_vars <- mapM (newWanted deeper_loc (ctEvRewriters work_item)) theta
+ ; setEvBindIfWanted work_item coherence (mk_ev (map getEvExpr evc_vars))
+ ; emitWorkNC (freshGoals evc_vars)
+ ; stopWith work_item "Dict/Top (solved wanted)" }
where
- ev = ctEvidence work_item
- pred = ctEvPred ev
- loc = ctEvLoc ev
+ pred = ctEvPred work_item
+ loc = ctEvLoc work_item
chooseInstance work_item lookup_res
= pprPanic "chooseInstance" (ppr work_item $$ ppr lookup_res)
@@ -147,27 +143,6 @@ checkInstanceOK loc what pred
| otherwise
= loc
-{- Note [Instances in no-evidence implications]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In #15290 we had
- [G] forall p q. Coercible p q => Coercible (m p) (m q))
- [W] forall <no-ev> a. m (Int, IntStateT m a)
- ~R#
- m (Int, StateT Int m a)
-
-The Given is an ordinary quantified constraint; the Wanted is an implication
-equality that arises from
- [W] (forall a. t1) ~R# (forall a. t2)
-
-But because the (t1 ~R# t2) is solved "inside a type" (under that forall a)
-we can't generate any term evidence. So we can't actually use that
-lovely quantified constraint. Alas!
-
-This test arranges to ignore the instance-based solution under these
-(rare) circumstances. It's sad, but I really don't see what else we can do.
--}
-
-
matchClassInst :: DynFlags -> InertSet
-> Class -> [Type]
-> CtLoc -> TcS ClsInstResult
=====================================
compiler/GHC/Tc/Solver/Equality.hs
=====================================
@@ -2647,23 +2647,45 @@ finishEqCt work_item@(EqCt { eq_lhs = lhs, eq_rhs = rhs, eq_eq_rel = eq_rel })
final_qci_check :: Ct -> EqRel -> TcType -> TcType -> TcS (StopOrContinue Ct)
-- The "final QCI check" checks to see if we have
-- [W] t1 ~# t2
--- and a Given quantified contraint like (forall a b. blah => a :~: b)
+-- and a Given quantified contraint like (forall a b. blah => a ~ b)
-- Why? See Note [Looking up primitive equalities in quantified constraints]
final_qci_check work_ct eq_rel lhs rhs
- | isWanted ev
- , Just (cls, tys) <- boxEqPred eq_rel lhs rhs
- = do { res <- matchLocalInst (mkClassPred cls tys) loc
- ; case res of
- OneInst { cir_mk_ev = mk_ev }
- -> chooseInstance work_ct
- (res { cir_mk_ev = mk_eq_ev cls tys mk_ev })
- _ -> continueWith work_ct }
-
- | otherwise
- = continueWith work_ct
+ = do { ev_binds_var <- getTcEvBindsVar
+ ; ics <- getInertCans
+ ; if isWanted ev -- Never look up Givens in quantified constraints
+ && not (null (inert_insts ics)) -- Shortcut common case
+ && not (isCoEvBindsVar ev_binds_var) -- See Note [Instances in no-evidence implications]
+ then try_for_qci
+ else continueWith work_ct }
where
ev = ctEvidence work_ct
loc = ctEvLoc ev
+ role = eqRelRole eq_rel
+
+ try_for_qci -- First try looking for (lhs ~ rhs)
+ | Just (cls, tys) <- boxEqPred eq_rel lhs rhs
+ = do { res <- matchLocalInst (mkClassPred cls tys) loc
+ ; traceTcS "final_qci_check:1" (ppr (mkClassPred cls tys))
+ ; case res of
+ OneInst { cir_mk_ev = mk_ev }
+ -> chooseInstance ev (res { cir_mk_ev = mk_eq_ev cls tys mk_ev })
+ _ -> try_swapping }
+ | otherwise
+ = continueWith work_ct
+
+ try_swapping -- Now try looking for (rhs ~ lhs) (see #23333)
+ | Just (cls, tys) <- boxEqPred eq_rel rhs lhs
+ = do { res <- matchLocalInst (mkClassPred cls tys) loc
+ ; traceTcS "final_qci_check:2" (ppr (mkClassPred cls tys))
+ ; case res of
+ OneInst { cir_mk_ev = mk_ev }
+ -> do { ev' <- rewriteEqEvidence emptyRewriterSet ev IsSwapped
+ (mkReflRedn role rhs) (mkReflRedn role lhs)
+ ; chooseInstance ev' (res { cir_mk_ev = mk_eq_ev cls tys mk_ev }) }
+ _ -> do { traceTcS "final_qci_check:3" (ppr work_ct)
+ ; continueWith work_ct }}
+ | otherwise
+ = continueWith work_ct
mk_eq_ev cls tys mk_ev evs
| sc_id : rest <- classSCSelIds cls -- Just one superclass for this
@@ -2672,6 +2694,27 @@ final_qci_check work_ct eq_rel lhs rhs
ev -> pprPanic "mk_eq_ev" (ppr ev)
| otherwise = pprPanic "finishEqCt" (ppr work_ct)
+{- Note [Instances in no-evidence implications]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In #15290 we had
+ [G] forall p q. Coercible p q => Coercible (m p) (m q)) -- Quantified
+ [W] forall <no-ev> a. m (Int, IntStateT m a)
+ ~R#
+ m (Int, StateT Int m a)
+
+The Given is an ordinary quantified constraint; the Wanted is an implication
+equality that arises from
+ [W] (forall a. t1) ~R# (forall a. t2)
+
+But because the (t1 ~R# t2) is solved "inside a type" (under that forall a)
+we can't generate any term evidence. So we can't actually use that
+lovely quantified constraint. Alas!
+
+This test arranges to ignore the instance-based solution under these
+(rare) circumstances. It's sad, but I really don't see what else we can do.
+-}
+
+
{-
**********************************************************************
* *
=====================================
compiler/GHC/Tc/Solver/Interact.hs
=====================================
@@ -1303,7 +1303,7 @@ doTopReactOther work_item
| otherwise
= do { res <- matchLocalInst pred loc
; case res of
- OneInst {} -> chooseInstance work_item res
+ OneInst {} -> chooseInstance ev res
_ -> continueWith work_item }
where
=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -1713,8 +1713,8 @@ just a coercion? i.e. evTermCoercion_maybe returns Nothing.
Consider [G] forall a. blah => a ~ T
[W] S ~# T
-Then doTopReactEqPred carefully looks up the (boxed) constraint (S ~
-T) in the quantified constraints, and wraps the (boxed) evidence it
+Then doTopReactEqPred carefully looks up the (boxed) constraint (S ~ T)
+in the quantified constraints, and wraps the (boxed) evidence it
gets back in an eq_sel to extract the unboxed (S ~# T). We can't put
that term into a coercion, so we add a value binding
h = eq_sel (...)
=====================================
compiler/GHC/Tc/Types.hs
=====================================
@@ -1592,7 +1592,7 @@ instance Outputable TcIdSigInfo where
ppr (CompleteSig { sig_bndr = bndr })
= ppr bndr <+> dcolon <+> ppr (idType bndr)
ppr (PartialSig { psig_name = name, psig_hs_ty = hs_ty })
- = text "psig" <+> ppr name <+> dcolon <+> ppr hs_ty
+ = text "[partial signature]" <+> ppr name <+> dcolon <+> ppr hs_ty
instance Outputable TcIdSigInst where
ppr (TISI { sig_inst_sig = sig, sig_inst_skols = skols
=====================================
configure.ac
=====================================
@@ -330,18 +330,6 @@ if test x"$TablesNextToCode" = xYES; then
fi
AC_SUBST(TablesNextToCode)
-dnl ** Does target have runtime linker support?
-dnl --------------------------------------------------------------
-case "$target" in
- powerpc64-*|powerpc64le-*|powerpc-ibm-aix*|s390x-ibm-linux|riscv64-*|wasm*|javascript-*|loongarch64-*)
- TargetHasRTSLinker=NO
- ;;
- *)
- TargetHasRTSLinker=YES
- ;;
-esac
-AC_SUBST(TargetHasRTSLinker)
-
# Requires FPTOOLS_SET_PLATFORMS_VARS to be run first.
FP_FIND_ROOT
=====================================
distrib/configure.ac.in
=====================================
@@ -20,9 +20,6 @@ bootstrap_target=@TargetPlatform@
bootstrap_llvm_target=@LlvmTarget@
-TargetHasRTSLinker=@TargetHasRTSLinker@
-AC_SUBST(TargetHasRTSLinker)
-
TargetHasLibm=@TargetHasLibm@
AC_SUBST(TargetHasLibm)
=====================================
hadrian/bindist/Makefile
=====================================
@@ -116,7 +116,6 @@ lib/settings : config.mk
@echo ',("target has GNU nonexec stack", "$(TargetHasGnuNonexecStack)")' >> $@
@echo ',("target has .ident directive", "$(TargetHasIdentDirective)")' >> $@
@echo ',("target has subsections via symbols", "$(TargetHasSubsectionsViaSymbols)")' >> $@
- @echo ',("target has RTS linker", "$(TargetHasRTSLinker)")' >> $@
@echo ',("target has libm", "$(TargetHasLibm)")' >> $@
@echo ',("Unregisterised", "$(GhcUnregisterised)")' >> $@
@echo ',("LLVM target", "$(LLVMTarget_CPP)")' >> $@
=====================================
hadrian/bindist/config.mk.in
=====================================
@@ -253,7 +253,6 @@ TargetWordBigEndian = @TargetWordBigEndian@
TargetHasGnuNonexecStack = @TargetHasGnuNonexecStack@
TargetHasIdentDirective = @TargetHasIdentDirective@
TargetHasSubsectionsViaSymbols = @TargetHasSubsectionsViaSymbols@
-TargetHasRTSLinker = @TargetHasRTSLinker@
TargetHasLibm = @TargetHasLibm@
TablesNextToCode = @TablesNextToCode@
=====================================
hadrian/cfg/system.config.in
=====================================
@@ -173,7 +173,6 @@ target-word-big-endian = @TargetWordBigEndian@
target-has-gnu-nonexec-stack = @TargetHasGnuNonexecStack@
target-has-ident-directive = @TargetHasIdentDirective@
target-has-subsections-via-symbols = @TargetHasSubsectionsViaSymbols@
-target-has-rts-linker = @TargetHasRTSLinker@
target-has-libm = @TargetHasLibm@
target-arm-version = @ARM_ISA@
=====================================
hadrian/src/Oracles/Setting.hs
=====================================
@@ -79,7 +79,6 @@ data Setting = BuildArch
| TargetOsHaskell
| TargetArmVersion
| TargetWordSize
- | TargetHasRtsLinker
| BourneShell
-- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions).
@@ -181,7 +180,6 @@ setting key = lookupSystemConfig $ case key of
TargetArchHaskell -> "target-arch-haskell"
TargetOsHaskell -> "target-os-haskell"
TargetWordSize -> "target-word-size"
- TargetHasRtsLinker -> "target-has-rts-linker"
BourneShell -> "bourne-shell"
bootIsStage0 :: Stage -> Stage
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -448,7 +448,6 @@ generateSettings = do
, ("target has GNU nonexec stack", expr $ lookupSystemConfig "target-has-gnu-nonexec-stack")
, ("target has .ident directive", expr $ lookupSystemConfig "target-has-ident-directive")
, ("target has subsections via symbols", expr $ lookupSystemConfig "target-has-subsections-via-symbols")
- , ("target has RTS linker", expr $ lookupSystemConfig "target-has-rts-linker")
, ("target has libm", expr $ lookupSystemConfig "target-has-libm")
, ("Unregisterised", expr $ yesNo <$> flag GhcUnregisterised)
, ("LLVM target", getSetting LlvmTarget)
=====================================
hadrian/src/Settings/Builders/RunTest.hs
=====================================
@@ -134,7 +134,10 @@ inTreeCompilerArgs stg = do
libdir <- System.FilePath.normalise . (top -/-)
<$> stageLibPath stg
- rtsLinker <- (== "YES") <$> setting TargetHasRtsLinker
+ -- For this information, we need to query ghc --info, however, that would
+ -- require building ghc, which we don't want to do here. Therefore, the
+ -- logic from `platformHasRTSLinker` is duplicated here.
+ let rtsLinker = not $ arch `elem` ["powerpc", "powerpc64", "powerpc64le", "s390x", "riscv64", "loongarch64", "javascript", "wasm32"]
return TestCompilerArgs{..}
=====================================
libraries/base/Data/Fixed.hs
=====================================
@@ -163,6 +163,13 @@ instance Enum (Fixed a) where
enumFromThenTo (MkFixed a) (MkFixed b) (MkFixed c) = fmap MkFixed (enumFromThenTo a b c)
-- | @since 2.01
+--
+-- Multiplication is not associative or distributive:
+--
+-- >>> (0.2 * 0.6 :: Deci) * 0.9 == 0.2 * (0.6 * 0.9)
+-- False
+-- >>> (0.1 + 0.1 :: Deci) * 0.5 == 0.1 * 0.5 + 0.1 * 0.5
+-- False
instance (HasResolution a) => Num (Fixed a) where
(MkFixed a) + (MkFixed b) = MkFixed (a + b)
(MkFixed a) - (MkFixed b) = MkFixed (a - b)
=====================================
libraries/base/GHC/Conc/Sync.hs
=====================================
@@ -33,6 +33,7 @@ module GHC.Conc.Sync
(
-- * Threads
ThreadId(..)
+ , fromThreadId
, showThreadId
, myThreadId
, killThread
@@ -148,11 +149,18 @@ garbage collected until you drop the 'ThreadId'. This misfeature would
be difficult to correct while continuing to support 'threadStatus'.
-}
+-- | Map a thread to an integer identifier which is unique within the
+-- current process.
+--
+-- @since 4.19.0.0
+fromThreadId :: ThreadId -> Word64
+fromThreadId tid = fromIntegral $ getThreadId (id2TSO tid)
+
-- | @since 4.2.0.0
instance Show ThreadId where
showsPrec d t = showParen (d >= 11) $
showString "ThreadId " .
- showsPrec d (getThreadId (id2TSO t))
+ showsPrec d (fromThreadId t)
showThreadId :: ThreadId -> String
showThreadId = show
=====================================
libraries/base/GHC/Float.hs
=====================================
@@ -279,7 +279,7 @@ class (RealFrac a, Floating a) => RealFloat a where
--
-- This instance implements IEEE 754 standard with all its usual pitfalls
-- about NaN, infinities and negative zero.
--- Neither addition not multiplication are associative or distributive:
+-- Neither addition nor multiplication are associative or distributive:
--
-- >>> (0.1 + 0.1 :: Float) + 0.5 == 0.1 + (0.1 + 0.5)
-- False
@@ -533,7 +533,7 @@ instance Show Float where
--
-- This instance implements IEEE 754 standard with all its usual pitfalls
-- about NaN, infinities and negative zero.
--- Neither addition not multiplication are associative or distributive:
+-- Neither addition nor multiplication are associative or distributive:
--
-- >>> (0.1 + 0.1) + 0.4 == 0.1 + (0.1 + 0.4)
-- False
=====================================
libraries/base/changelog.md
=====================================
@@ -4,6 +4,7 @@
* Add `{-# WARNING in "x-partial" #-}` to `Data.List.{head,tail}`.
Use `{-# OPTIONS_GHC -Wno-x-partial #-}` to disable it.
([CLC proposal #87](https://github.com/haskell/core-libraries-committee/issues/87) and [#114](https://github.com/haskell/core-libraries-committee/issues/114))
+ * `GHC.Conc.Sync` now exports `fromThreadId :: ThreadId -> Word64`, which maps a thread to a per-process-unique identifier ([CLC proposal #117](https://github.com/haskell/core-libraries-committee/issues/117))
* Add `Data.List.!?` ([CLC proposal #110](https://github.com/haskell/core-libraries-committee/issues/110))
* `maximumBy`/`minimumBy` are now marked as `INLINE` improving performance for unpackable
types significantly.
=====================================
testsuite/tests/quantified-constraints/T23333.hs
=====================================
@@ -0,0 +1,8 @@
+{-# LANGUAGE QuantifiedConstraints #-}
+module T23333 where
+
+foo1 :: (forall y. Bool ~ y) => z -> Bool
+foo1 x = not x
+
+foo2 :: (forall y. y ~ Bool) => z -> Bool
+foo2 x = not x
=====================================
testsuite/tests/quantified-constraints/all.T
=====================================
@@ -41,4 +41,4 @@ test('T22216d', normal, compile, [''])
test('T22216e', normal, compile, [''])
test('T22223', normal, compile, [''])
test('T19690', normal, compile_fail, [''])
-
+test('T23333', normal, compile, [''])
=====================================
testsuite/tests/typecheck/should_fail/T17284.hs
=====================================
@@ -0,0 +1,9 @@
+{-# LANGUAGE MonomorphismRestriction #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+
+module MonoPoly where
+
+f :: Num a => a -> _
+f x = x + y
+
+y = f 1
=====================================
testsuite/tests/typecheck/should_fail/T17284.stderr
=====================================
@@ -0,0 +1,4 @@
+
+T17284.hs:6:1: error: [GHC-16675]
+ Overloaded signature conflicts with monomorphism restriction
+ [partial signature] f :: Num a => a -> _
=====================================
testsuite/tests/typecheck/should_fail/all.T
=====================================
@@ -681,3 +681,4 @@ test('LazyFieldsDisabled', normal, compile_fail, [''])
test('TyfamsDisabled', normal, compile_fail, [''])
test('CommonFieldResultTypeMismatch', normal, compile_fail, [''])
test('CommonFieldTypeMismatch', normal, compile_fail, [''])
+test('T17284', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/875d394a498dbacc7a6527cbc4c5ebd612c1ab36...c2efebb73f835e2c6a93f1c7040c2540368bcf01
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/875d394a498dbacc7a6527cbc4c5ebd612c1ab36...c2efebb73f835e2c6a93f1c7040c2540368bcf01
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/20230510/d2d2b007/attachment-0001.html>
More information about the ghc-commits
mailing list